C          DATA SET MAIN       AT LEVEL 018 AS OF 03/16/79              00000010
C                                                                       00000020
C MAIN PROGRAM                                                          00000030
C                                                                       00000040
C TBERR -- TWO BODY ERROR ANALYSIS PROGRAM                              00000050
C                                                                       00000060
C                                                                       00000070
C                                                                       00000080
C     MAIN PROGRAM                                                      00000090
C                                                                       00000100
C                                                                       00000110
C                                                                       00000120
C     THE PURPOSE OF THE MAIN PROGRAM IS TO INITIALIZE PROGRAM VARIABLES00000130
C         AND CONTROL PROGRAM EXECUTION.                                00000140
C                                                                       00000150
C                                                                       00000160
C                                                                       00000170
C     THERE ARE NO ARGUMENTS IN THE CALLING SEQUENCE. ALL INPUT AND     00000180
C         OUTPUT VARIABLES ARE PASSED THROUGH NAMELIST AND COMMON.      00000190
C                                                                       00000200
C                                                                       00000210
C                                                                       00000220
C     NO SUBROUTINES CALL THE MAIN PROGRAM.                             00000230
C                                                                       00000240
C                                                                       00000250
C                                                                       00000260
C     THE FOLLOWING SUBROUTINES ARE CALLED BY THE MAIN PROGRAM.         00000270
C                                                                       00000280
C     COVIN     CVPROP    GEOS      GUIDE     ORB2X     STATS   SCAN    00000290
C                                                                       00000300
C                                                                       00000310
C                                                                       00000320
C     THE VARIABLES APPEARING IN COMMON BLOCKS ARE TABULATED BELOW.     00000330
C                                                                       00000340
C         COMMON VARIABLES USED                                         00000350
C                                                                       00000360
C         AINPUT    IFRN      ITOPT     LU16      NCONF     XII         00000370
C         ANOM      IHIST     LU8       LU20      TOLR      XMU         00000380
C         ICOV      IOP       LU9                                       00000390
C                                                                       00000400
C         COMMON VARIABLE COMPUTED                                      00000410
C                                                                       00000420
C         AINTRI                                                        00000430
C                                                                       00000440
C         COMMON VARIABLES USED AND COMPUTED                            00000450
C                                                                       00000460
C         EL        IKEY      ITPSTR    MODE      TERR      ZUB         00000470
C                                                                       00000480
C                                                                       00000490
C                                                                       00000500
C     THE FOLLOWING VARIABLES MAY BE READ IN THROUGH THE NAMELIST.      00000510
C                                                                       00000520
C         AINPUT    DRTOL     FNS       ISCFLG    P1II      TUB         00000530
C         AINSYI    DTBI      ICOV      ITOPT     P2II      WAH         00000540
C         AIS       DTCI      ICVOUT    ITPSTR    P3II      WCI         00000550
C         ALAMDI    DT1I      IFLAG     IW        P4II      WI          00000560
C         ALD       DT2I      IFRN      LEG       P5II      WWCI        00000570
C         ALF       DT3I      IGUIDI    LUTP      P6II      XII         00000580
C         ALI       DT4I      IHIST     LU8       RA        XISPH       00000590
C         ANOM      DT5I      IKEY      LU9       SIGBI     XISPI       00000600
C         AP        DT6I      IOP       LU16      STAFI     XMU         00000610
C         AS        DVINI     IP1COR    LU20      TAMAN     XMU2        00000620
C         ASM       DVNI      IP2COR    MODE      TERR      XTI         00000630
C         DEC       ELI       IP3COR    NBURN     THRI      X2I         00000640
C         DELNOI    ES        IP4COR    NCONF     THRUSI    YAWI        00000650
C         DIS       ESM       IP5COR    NMLIST    TOLR      ZUB         00000660
C         DNS       FIS       IP6COR    PITCHI                          00000670
C                                                                       00000680
C                                                                       00000690
C                                                                       00000700
      IMPLICIT REAL*8(A-H,O-Y)                                          00000710
      REAL*8 NAMES,ZB                                                   00000720
      DIMENSION JJ(50),TEMP(50),SUMX(50),SUMX2(50)                      00000730
      DIMENSION XI(6),PII(21),C2(50)                                    00000740
      DIMENSION XC(6),P(6,6),ELT(50)                                    00000750
      DIMENSION TITLE(10),ZB(50),ZBH(10000),A(50),TESTP(5)              00000760
      COMMON /GENRL/ P1,PI(6,6),XII(6),XMU,NAMES(6),PITCHI,YAWI,WI,     00000770
     A P1I(6,6),P2I(6,6),P3I(6,6),P4I(6,6),P5I(6,6),P6I(6,6),TOLR(50),  00000780
     * THRUSI,SIGBI(3),ZDELT,ZUB(3,50),                                 00000790
     B IP1COR,IP2COR,IP3COR,IP4COR,IP5COR,IP6COR,                       00000800
     1 ICOV(50),IHIST(50),IPCOOR,ITPSTR,NCONF,MODE                      00000810
     2 ,IKEY,IFRN                                                       00000820
C                                                                       00000830
      COMMON /GEO/ AINSYI,AINTRI,AIS,ALAMDI,ANOM,AP,AS,ASM,             00000840
     1 DELNOI,DRTOL,DSMA,DVINI,DVNI,                                    00000850
     1EL(6),ES,ESM,SDAY,SNODE,STAFI,TCOV,TAMAN,                         00000860
     3 TERR,TUB,WAH,XB(6),XISPH,XISPI,DIS,FIS,DNS,FNS,ALI,ALF,ALD,      00000870
     4 IGUIDI,IOP,IW,LEG,IFLAG,ITOPT,ISCFLG, SCNPAR(3,5)                00000880
      COMMON/CVPR/ DTBI,DTCI,WCI,RA,DEC,THRI(100),WWCI(100),NBURN,      00000890
     1 ICVOUT                                                           00000900
      COMMON/COMT/ DT1I,DT2I,DT3I,DT4I,DT5I,DT6I,XTI(6),X2I(6),XMU2     00000910
      COMMON /INPUT/ AINPUT(20)                                         00000920
      COMMON /LSCAN/LUNIT                                               00000930
      COMMON/LUS/LU8,LU9,LU16,LU20,LU21,LU25                            00000940
      COMMON /PKMCOM/ XISPJ,DVINJ,DECPKM,RAPKM,TERRJ,SIGBJ(2),          00000950
     * DELNOJ,AINSYJ,ASJ,TAM,LEGJ,IGUIDJ,ITO,JPKM                       00000960
      COMMON/TSCAN/WAPKM,TAKMAN,AKMWT,ISCANT(50),IUP,ISCAN(5)           00000970
      COMMON/MANINP/AMAN(6),VREOR,AKMIN                                 00000980
       COMMON/NOPRNT/NMLIST                                             00000990
C                                                                       00001000
      DIMENSION P1II(21),P2II(21),P3II(21),P4II(21),P5II(21),P6II(21)   00001010
      DIMENSION ELI(6)                                                  00001020
      DATA P1II,P2II,P3II,P4II,P5II,P6II/126*0.D0/                      00001030
      DATA LUTP/00/,ZB,C2,A/150*0.0D0/                                  00001040
      NAMELIST /TBDATA/DTCI,DTBI,WI,WCI,PITCHI,YAWI,THRUSI,NCONF,       00001050
     A P1II,P2II,P3II,P4II,P5II,P6II,IP1COR,IP2COR,IP3COR,IP4COR,       00001060
     B IP5COR,IP6COR,ICOV,ICVOUT,TOLR,                                  00001070
     C RA,DEC,THRI,WWCI,DT1I,DT2I,DT3I,DT4I,DT5I,DT6I,XTI,X2I,XMU2,     00001080
     2AS,ES,AIS,NBURN,SIGBI,ZUB,XII,IHIST,XMU,IFLAG,NMLIST              00001090
     3 ,ALAMDI,XISPI,AINSYI,DELNOI,DVINI,DVNI,IGUIDI,ELI,ANOM,IOP,      00001100
     4DRTOL,LEG,ASM,ESM,XISPH,WAH,IW,TUB,AP,STAFI,ITPSTR,LUTP,MODE      00001110
     5 ,AINPUT,TERR,ITOPT,IKEY,IFRN,DIS,FIS,DNS,FNS,ALI,ALF,ALD,ISCFLG  00001120
     6,TAMAN,LU8,LU9,LU16,LU20,XISPJ,DVINJ,DECPKM,RAPKM,TERRJ,SIGBJ,    00001130
     * DELNOJ,AINSYJ,ASJ,TAM,LEGJ,IGUIDJ,ITO,JPKM,LU21,LU25,ISCAN,      00001140
     *SCNPAR,ISCANT,AMAN,VREOR,AKMIN,LUNIT                              00001150
      CALL LIST(5)                                                      00001160
C  THIS DO LOOP INITIALIZES THE VALUES FOR THE BEGINNING (ZUB(1,I))     00001170
C  AND FINAL VALUES (ZUB(3,I)) OF THE HISTOGRAMS, SETS THE NO. OF       00001180
C  INTERVALS (ZUB(2,I)) IN THE HISTOGRAMS, AND INITIALIZES ORBITAL      00001190
C  PARAMETER ARRAY, A                                                   00001200
      DO 5 I=1,50                                                       00001210
      ZUB(1,I) = 0.                                                     00001220
      ZUB(2,I) =35.                                                     00001230
      ZUB(3,I) = 0.                                                     00001240
      A(I)=0.D0                                                         00001250
    5 CONTINUE                                                          00001260
      MODE=0                                                            00001270
C                                                                       00001280
   10 READ (5,500,END=9999) (TITLE(I),I=1,10)                           00001290
      WRITE(6,600) (TITLE(I),I=1,10)                                    00001300
C                                                                       00001310
      ITPSTR=0                                                          00001320
C  READ THE NAMELIST INPUT, THE ONLY NAMELIST INPUT IN MONITOR          00001330
      READ (5,TBDATA)                                                   00001340
      DO 9 IX=1,6                                                       00001350
C  ELI CONTAINS THE KEPLERIAN ELEMENTS OF THE INITIAL ORBIT             00001360
   9  EL(IX)=ELI(IX)                                                    00001370
      WRITE(LU16,600) (TITLE(I),I=1,10)                                 00001380
      IF(IOP.EQ.0)AINTRI=ELI(5)                                         00001390
      IKEYA=IKEY                                                        00001400
C  ITOPT=1 INDICATES AN AKM TIMING ERROR; ITO=1 INDICATES A PKM TIMING  00001410
C  ERROR                                                                00001420
      IF(ITOPT.EQ.1) TERRA=TERR                                         00001430
      IF(ITO.EQ.1) TERRB=TERRJ                                          00001440
      WRITE(6,1000)                                                     00001450
      WRITE(6,1010) NCONF,IOP,ITPSTR,LUTP,MODE,IKEY,IFRN                00001460
     1,LU8,LU9,LU16,LU20                                                00001470
      WRITE(6,1020) (ICOV(I),I=1,14)                                    00001480
      WRITE(6,1030) (IHIST(I),I=1,50)                                   00001490
      N=0                                                               00001500
      DO 11 II=1,50                                                     00001510
      IF(TOLR(II).EQ.0)GO TO 11                                         00001520
      N=N+1                                                             00001530
      JJ(N)=II                                                          00001540
      TEMP(N)=TOLR(II)                                                  00001550
   11 CONTINUE                                                          00001560
      IF(N.EQ.0)GO TO 1111                                              00001570
      WRITE(6,1040)((JJ(I),TEMP(I)),I=1,N)                              00001580
 1111 CONTINUE                                                          00001590
      WRITE(6,1050) (ZUB(1,I),I=1,50)                                   00001600
      WRITE(6,1060) (ZUB(2,I),I=1,50)                                   00001610
      WRITE(6,1070) (ZUB(3,I),I=1,50)                                   00001620
      WRITE (6,1075) AINPUT                                             00001630
 1075 FORMAT(1H0,'AINPUT = ',10D12.5,/,10X,10D12.5)                     00001640
 1000 FORMAT(1H0,57X,'CONTROL INPUTS',//)                               00001650
 1010 FORMAT(1H0,' NCONF =',I5,6X,'   IOP =',I5,6X,                     00001660
     1'ITPSTR =',I5,6X,'  LUTP =',I5,6X,'  MODE =',I5,6X,               00001670
     2 '  IKEY =',I5,6X,'  IFRN =',I8,                                  00001680
     3 /,1X,'   LU8 =',I5,6X,'   LU9 =',I5,6X,'  LU16 =',I5,6X,         00001690
     4'  LU20 =',I5)                                                    00001700
 1020 FORMAT(1H0,'  ICOV =',6I3,//9X,2I3,//9X,6I3)                      00001710
 1030 FORMAT(1H0,' IHIST =',25I3/10X,25I3)                              00001720
 1040 FORMAT(1H0,'TOLR(',I2,') =',D15.8,2X)                             00001730
 1050 FORMAT(1H0,'ZUB(1) =',25F4.0/9X,25F4.0)                           00001740
 1060 FORMAT(1H0,'ZUB(2) =',25F4.0/9X,25F4.0)                           00001750
 1070 FORMAT(1H0,'ZUB(3) =',25F4.0/9X,25F4.0)                           00001760
      WRITE(6,1080) ANOM                                                00001770
C  IOP=0 INDICATES ORBIT INPUT DATA ARE KEPLERIAN ELEMENTS; IOP .NE. 0  00001780
C  INDICATES INPUT DATA ARE CARTESIAN ELEMENTS                          00001790
      IF(IOP.EQ.0) GO TO 333                                            00001800
      WRITE(6,1090) (XII(I),I=1,6)                                      00001810
      GO TO 300                                                         00001820
C  ELI .GE. 1 IS A FLAG SIGNALLING THAT ELI(1)=APOGEE BIAS; ELI(2)=     00001830
C  PERIGEE BIAS                                                         00001840
  333 IF(ELI(2).GE.1.D0)WRITE(6,1091)(ELI(J),J=1,2)                     00001850
      IF(ELI(2).LT.1.D0)WRITE(6,1100)(EL(J),J=1,6)                      00001860
C  ELEMENT CONVERSION                                                   00001870
      IF(ELI(2).LT.1.D0)GOTO12                                          00001880
C  ELI(1)=BIAS(RM)                                                      00001890
C  ELI(2)=PERIGEE ALT(RM)                                               00001900
      EL(1)=(ELI(1)+ELI(2) + 48542.0D0)/2.0D0                           00001910
      EL(2)=1.0D0 -(ELI(2) + 6378.D0)/EL(1)                             00001920
C  EL(1)=SEMIMAJOR AXIS                                                 00001930
C  EL(2)=ECCENTRICITY                                                   00001940
      WRITE(6,1100)(EL(J),J=1,6)                                        00001950
  12  CONTINUE                                                          00001960
1091  FORMAT(1H0,'BIAS=',D15.8,2X,' HP=',D15.8,//)                      00001970
  300 CONTINUE                                                          00001980
 1080 FORMAT(1H0,57X,'INITIAL STATES',/,58X,'ANOM =',D10.2)             00001990
 1100 FORMAT(1H0,57X,'KEPLERIAN ELEMENTS',/,2X,                         00002000
     *'A =',D15.8,2X,'E =',D15.8,2X,'TA/M =',D15.8,2X,                  00002010
     *'N =',D15.8,2X,'I =',D15.8,2X,'W =',D15.8,//)                     00002020
 1090 FORMAT(1H0,57X,'CARTESIAN ELEMENTS',/,2X,                         00002030
     *'X =',D15.8,2X,'Y =',D15.8,2X,'Z =',D15.8,2X,                     00002040
     *'XD =',D15.8,2X,'YD =',D15.8,2X,'ZD =',D15.8,//)                  00002050
      IF(NMLIST.NE.0) WRITE(6,TBDATA)                                   00002060
C  AKMIN=TARGET INCLINATION FOR DRIFT ORBIT;  AKMIN IS SET EQUAL TO     00002070
C  AINSYI (THE TARGET I FOR SYNCHRONOUS ORBIT) HERE FOR PURPOSE OF      00002080
C  NOMINAL ORBIT CALCULATIONS.                                          00002090
C     AINC=AKMIN                                                        00002100
C     AKMIN=AINSYI                                                      00002110
      NP=NCONF                                                          00002120
      IHFLG=0                                                           00002130
      IF(ITPSTR.GT.0) GO TO 201                                         00002140
      ITPSTR=1                                                          00002150
      IF(IOP.EQ.0) CALL ORB2X(XII(1),XII(4),EL,XMU,ANOM)                00002160
C                                                                       00002170
C                                                                       00002180
C  COVARIANCE MATRICES P1II-P6II CALCULATED BY COVIN                    00002190
      CALL COVIN(P1II,P2II,P3II,P4II,P5II,P6II)                         00002200
      IF (NP.LE.0) GO TO 15                                             00002210
      IF(NP.GT.10000) NP=10000                                          00002220
   15 CONTINUE                                                          00002230
      IF (NP.LE.0) GO TO 10                                             00002240
      NP1 = NP+1                                                        00002250
C                                                                       00002260
      IHST=0                                                            00002270
      DO 110 IH=1,50                                                    00002280
      SUMX(IH)=0.D0                                                     00002290
      SUMX2(IH)=0.D0                                                    00002300
      IF(IHIST(IH).EQ.0) GO TO 110                                      00002310
      IHST=IHST+1                                                       00002320
  110 CONTINUE                                                          00002330
      IHFLG=0                                                           00002340
      IF(NP*IHST.LE.10000) IHFLG=1                                      00002350
      DO 200 J = 1,NP1                                                  00002360
      K=J-1                                                             00002370
C  MODE=0:  ANALYTIC STATE COVARIANCE MATRIX PROPAGATION USING STATE    00002380
C  TRANSITION MATRICES FOR COASTING AND POWERED BURN PHASES OF THE      00002390
C  TRAJECTORY.                                                          00002400
      IF(MODE.EQ.0) CALL CVPROP(P1II,IOP,A,K,ELT)                       00002410
C  MODE=1:  GEOSYNCHRONOUS MISSION SIMULATION FROM TRANSFER ORBIT       00002420
C  INJECTION THROUGH STATION ACQUISITION.                               00002430
      IF(MODE.EQ.1) CALL GEOS(A,K,ELT)                                  00002440
C  MODE=2:  NOMINAL SCAN COMPUTATIONS                                   00002450
      IF(MODE.EQ.2) CALL SCAN                                           00002460
      IF(MODE.GE.3) CALL GUIDE(A,K,ELT)                                 00002470
      IF(NCONF.EQ.1) GO TO 10                                           00002480
      IF(NCONF.EQ.2)GOTO260                                             00002490
      DO 180 I=1,50                                                     00002500
      IF (K.GT.0) GO TO 525                                             00002510
      C2(I)=A(I)                                                        00002520
      GO TO 180                                                         00002530
  525 CONTINUE                                                          00002540
      ZB(I)=A(I)-C2(I)                                                  00002550
      SUMX(I)=SUMX(I)+A(I)                                              00002560
      SUMX2(I)=SUMX2(I)+A(I)**2                                         00002570
C                                                                       00002580
  180 CONTINUE                                                          00002590
      IF(K.NE.0) GO TO 185                                              00002600
C  AKMIN=AINC (TEMPORARY POSITION FOR THE DESIRED ORBIT INCLINATION).   00002610
C  THIS IS DONE AFTER THE NOMINAL ORBIT CALCULATIONS HAVE BEEN COMPLETED00002620
C     AKMIN=AINC                                                        00002630
      IF(LUTP.LT.0.AND.IHFLG.EQ.0) GO TO 9991                           00002640
      IF(LUTP.LT.0) GO TO 188                                           00002650
      WRITE(LU20)ELT                                                    00002660
      WRITE(LU20)C2                                                     00002670
      IF(LUTP.EQ.0.OR.LUTP.EQ.LU20)GO TO 200                            00002680
      WRITE(LU20)ZB                                                     00002690
      WRITE(LUTP) ELT                                                   00002700
      WRITE(LUTP) C2                                                    00002710
      GO TO 200                                                         00002720
  185 IF(LUTP.LT.0) GO TO 188                                           00002730
      WRITE(LU20)ZB                                                     00002740
      IF(LUTP.EQ.0.OR.LUTP.EQ.LU20)GO TO 187                            00002750
      WRITE(LUTP) ZB                                                    00002760
  187 IF(IHFLG.EQ.0) GO TO 200                                          00002770
  188 IHST=0                                                            00002780
      DO 190 IH=1,50                                                    00002790
      IF(IHIST(IH).EQ.0) GO TO 190                                      00002800
      IHST=IHST+1                                                       00002810
      INDX=K+(IHST-1)*NP                                                00002820
      ZBH(INDX)=ZB(IABS(IHIST(IH)))                                     00002830
 190  CONTINUE                                                          00002840
  200 CONTINUE                                                          00002850
      WRITE(6,700)                                                      00002860
      XNP=NP                                                            00002870
      DO 250 I=1,50                                                     00002880
      AMEAN=SUMX(I)/XNP                                                 00002890
      VAR = (SUMX2(I)-SUMX(I)**2/XNP)/(XNP-1.D0)                        00002900
      IF(VAR .LT. 0.D0) VAR=0.D0                                        00002910
      SIGMA = DSQRT(VAR)                                                00002920
C  THIS WRITE STATEMENT PRINTS OUT THE OUTPUT PARAMETER SUMMARY TABLE.  00002930
C  C2 CONTAINS THE NOMINAL ORBIT VALUES; AMEAN CONTAINS THE AVERAGE     00002940
C  VALUE; SIGMA CONTAINS THE STANDARD DEVIATION                         00002950
      WRITE(6,705)   ELT(I),C2(I),AMEAN,SIGMA                           00002960
      WRITE(LU16,705)ELT(I),C2(I),AMEAN,SIGMA                           00002970
  250 CONTINUE                                                          00002980
      GOTO270                                                           00002990
  260 DO265I=1,50                                                       00003000
      WRITE(6,706)ELT(I),A(I)                                           00003010
 265  WRITE(LU16,706)ELT(I),A(I)                                        00003020
      IF(LU21 .GT. 0) WRITE(LU21) (A(I),I=1,50)                         00003030
      WRITE(6,725)                                                      00003040
      GOTO10                                                            00003050
 706  FORMAT(1X,A8,2X,'NOMINAL=',1PE12.4)                               00003060
 270  WRITE(6,725)                                                      00003070
      IF(LUTP.LT.0) GO TO 201                                           00003080
      IF(LUTP.NE.0.AND.LUTP.NE.LU20)ENDFILE LUTP                        00003090
  201 CONTINUE                                                          00003100
C  SUBROUTINE STATS AND THE SUBPROGRAMS IT CALLS PREPARE THE HISTOGRAMS 00003110
      CALL STATS(LUTP,ELT,IHFLG,NP,TITLE,ZBH,C2)                        00003120
      IF(LUTP.GE.0)REWIND LU20                                          00003130
      IKEY=IKEYA                                                        00003140
      IF(ITOPT.EQ.1) TERR=TERRA                                         00003150
      IF(ITO.EQ.1) TERRJ=TERRB                                          00003160
      GO TO 10                                                          00003170
 9991 WRITE(6,9992)                                                     00003180
 9992 FORMAT(1H0,'*** RUN TERMINATED ***',3X,                           00003190
     1'DISK NOT USED AND ALL SAMPLES COULD NOT BE STORED IN CORE')      00003200
 9999 CONTINUE                                                          00003210
      STOP                                                              00003220
  500 FORMAT (10A8)                                                     00003230
  600 FORMAT (1H1,4X,10A8)                                              00003240
  700 FORMAT(1H0,30X,'OUTPUT PARAMETER SUMMARY')                        00003250
  725 FORMAT(1H0)                                                       00003260
  705 FORMAT(1X,A8,2X,'NOMINAL=',1PE12.4,2X,'MEAN=',                    00003270
     1 1PE12.4,2X,'SIGMA=',1PE12.4)                                     00003280
      END                                                               00003290
C          DATA SET ADOT       AT LEVEL 002 AS OF 05/15/79
C          DATA SET ADOT       AT LEVEL 001 AS OF 04/04/78              00001
C                                                                       00002
C  REAL FUNCTION ADOT*8 (X,Y)                                           00003
C                                                                       00004
C  ADOT COMPUTES THE ANGLE BETWEEN TWO VECTORS X AND Y.                 00005
C                                                                       00006
C  ARGUMENTS IN THE CALLING SEQUENCE ARE DEFINED AS FOLLOWS:            00007
C                                                                       00008
C  ARGUMENT   TYPE   I/O     DEFINITION                                 00009
C                                                                       00010
C     X       R*8     I     FIRST INPUT VECTOR                          00011
C     Y       R*8     I     SECOND INPUT VECTOR                         00012
C     ADOT    R*8     O     ANGLE BETWEEN X AND Y                       00013
C                                                                       00014
C  ADOT IS CALLED BY THE FOLLOWING SUBROUTINES:                         00015
C                                                                       00016
C     MODE2     RANTAR                                                  00017
C                                                                       00018
C  ADOT CALLS THE FOLLOWING SUBROUTINES:                                00019
C                                                                       00020
C     DOT                                                               00021
C                                                                       00022
C  THE VARIABLE APPEARING IN A COMMON BLOCK WHICH IS USED IS            00023
C  GIVEN BELOW:                                                         00024
C                                                                       00025
C  COMMON VARIABLE USED:  R2D                                           00026
C                                                                       00027
C                                                                       00028
      REAL FUNCTION ADOT*8 (X,Y)                                        00029
      IMPLICIT REAL*8(A-H,O-Z,$)                                        00030
      COMMON /CONST/ S2LB,D2R,XPI,R2D,F2KM,XKM2F,G0                     00031
      DIMENSION      X(3),Y(3),C(3)                                     00032
    1 C(1) = DOT(X,X)                                                   00033
      C(2) = DOT(X,Y)                                                   00034
      C(3) = DOT(Y,Y)                                                   00035
      SCL = DMAX1(C(1),C(3))                                            00036
      ADOT = 0.D0                                                       00037
      IF (SCL.EQ.0.D0) RETURN                                           00038
      DO 2 I=1,3                                                        00039
    2 C(I) = C(I)/SCL                                                   00040
      SCL = DSQRT(DABS(C(1)*C(3)-C(2)*C(2)))                            00041
      IF (SCL.EQ.0.D0) RETURN                                           00042
      IF (C(2).EQ.0.D0) RETURN                                          00043
      ADOT=R2D*DATAN2(SCL,C(2))                                         00044
      RETURN                                                            00045
      END                                                               00046
      SUBROUTINE AEIN(AS,ES,A,RA,RP,DVN,AIS,AI,AN,ANS,APF,ASM,ESM,      00000010
     1 DVS,VIN,AMAN,RM,MAN6,XMU)                                        00000020
C                                                                       00000030
C                                                                       00000040
C  SUBROUTINE AEIN(AS,ES,A,RA,RP,DVN,AIS,AI,AN,ANS,APF,ASM,ESM,         00000050
C  1 DVS,VIN,AMAN,RM,MAN6,XMU)                                          00000060
C                                                                       00000070
C  AEIN SIMULATES A COMBINED MANEUVER, IN WHICH THE INCLINATION AND     00000080
C  RIGHT ASCENSION OF THE ASCENDING NODE (AND THE SEMI-MAJOR AXIS       00000090
C  AND ECCENTRICITY ALSO, IF DESIRED) ARE ALTERED.  THE PURPOSE         00000100
C  OF AEIN IS TO DETERMINE THE VELOCITY REQUIREMENTS FOR THE            00000110
C  DESIRED MANEUVER.                                                    00000120
C                                                                       00000130
C  ARGUMENTS IN THE CALLING SEQUENCE ARE DEFINED AS FOLLOWS:            00000140
C                                                                       00000150
C   ARGUMENT    TYPE   I/O     DEFINITION                               00000160
C                                                                       00000170
C     AS        R*8     I     DESIRED SEMI-MAJOR AXIS                   00000180
C     ES        R*8     I     DESIRED ECCENTRICITY                      00000190
C     A         R*8     I     SEMI-MAJOR AXIS BEFORE MANEUVER BEGINS    00000200
C     RA        R*8     I     APOGEE RADIUS BEFORE MANEUVER BEGINS      00000210
C     RP        R*8     I     PERIGEE RADIUS BEFORE MANEUVER BEGINS     00000220
C     DVN       R*8     I     NODE CHANGE FLAG (+1=YES;-1=NO)           00000230
C     AIS       R*8     I     DESIRED INCLINATION                       00000240
C     AI        R*8     I     INITIAL INCLINATION                       00000250
C     AN        R*8     I     INITIAL RIGHT ASCENSION OF THE            00000260
C                             ASCENDING NODE                            00000270
C     ANS       R*8     I     DESIRED RIGHT ASCENSION OF THE            00000280
C                             ASCENDING NODE                            00000290
C     APF       R*8     I     ARGUMENT OF PERIGEE                       00000300
C     ASM       R*8     I     DESIRED SEMI-MAJOR AXIS                   00000310
C     ESM       R*8     I     DESIRED ECCENTRICITY                      00000320
C     DVS       R*8    I/O    TOTAL DELTA VELOCITY (RUNNING TOTAL)      00000330
C     VIN       R*8     O     DELTA VELOCITY NEEDED TO PERFORM THE      00000340
C                             DESIRED MANEUVER                          00000350
C     AMAN      R*8     I     VARIABLE USED TO INDICATE THE FRACTIONAL  00000360
C                             AMOUNT OF THE AE CORRECTION ACHIEVABLE    00000370
C     RM        R*8     O     VALUE OF RADIUS OF PERIGEE, IF COMBINED   00000380
C                             MANEUVER AT PERIGEE; VALUE OF RADIUS OF   00000381
C                             APOGEE, IF COMBINED MANEUVER AT APOGEE    00000382
C     MAN6      I*4     I     FLAG, IF MAN6<0, THE COMBINED MANEUVER    00000390
C                             OCCURS AT PERIGEE; IF MAN6>0, THE COMBINED00000391
C                             MANEUVER OCCURS AT APOGEE.  NOTE: DO NOT  00000392
C                             SET MAN6=0                                00000393
C     XMU       R*8     I     GRAVITATIONAL CONSTANT FOR THE EARTH      00000400
C                                                                       00000410
C  AEIN IS CALLED BY THE FOLLOWING SUBROUTINE:                          00000420
C                                                                       00000430
C     BDELVS                                                            00000440
C                                                                       00000450
C  AEIN CALLS THE FOLLOWING SUBROUTINES:                                00000460
C                                                                       00000470
C     CROSS, DOT, FNORM, ORB, ORB2X, SARA, UCROSS                       00000480
C                                                                       00000490
C  THE VARIABLES APPEARING IN COMMON ARE TABULATED BELOW:               00000500
C                                                                       00000510
C   COMMON VARIABLES USED:                                              00000520
C                                                                       00000530
C       D2R,R2D                                                         00000540
C                                                                       00000550
C                                                                       00000560
      IMPLICIT REAL*8(A-H,O-Z)                                          00000570
      DIMENSION HS(3), H(3),AP(3),XN(3),APX(3),R(3),V(3)                00000580
      DIMENSION EL(6),AX(3),VS(3),DDV(3),XNV(3)                         00000590
      DIMENSION FLPA(2),VFPA(2),UVFPA(3),UVIN(3)                        00000600
      DIMENSION COMB(6),COM(6)                                          00000610
      EQUIVALENCE (AKC(1),COM(1)),(AKC(7),R(1)),(AKC(10),VS(1))         00000620
      COMMON/CONST/S2LB,D2R,XPI,R2D,F2KM,XKM2F,GO                       00000630
      COMMON/ELEM/AKC(12)                                               00000640
      COMMON/NOPRNT/NMLIST                                              00000650
      PII=180.0*D2R                                                     00000660
      AS1=ASM                                                           00000670
      ES1=ESM                                                           00000680
C  TEST TO SEE WHETHER SECOND MANEUVER, IF SO THE PROGRAM WILL          00000690
C  GIVE A THE VALUE FOUND FROM THE PREVIOUS MANEUVER.                   00000700
      IF (AKC(1).EQ.0.) GO TO 42                                        00000710
      A = AKC(1)                                                        00000720
      RA=A*(1.D0+AKC(2))                                                00000730
C  TEST INCLINATION AND NODE VALUES                                     00000740
   42 AISP=AIS                                                          00000750
      IF(AIS.LT.0.D0) AISP=AI                                           00000760
      ANSP=ANS                                                          00000770
      IF(DVN.LT.0.D0)ANSP=AN                                            00000780
C  COMPUTE ANGULAR-MOMENTUM VECTOR OF INITIAL ORBIT                     00000790
      H(1) =DSIN(AN)*DSIN(AI)                                           00000800
      H(2)= -DCOS(AN)*DSIN(AI)                                          00000810
      H(3)=DCOS(AI)                                                     00000820
C  COMPUTE ANGULAR-MOMENTUM VECTOR OF DESIRED ORBIT                     00000830
      HS(1)= DSIN(ANSP)*DSIN(AISP)                                      00000840
      HS(2)= -DCOS(ANSP)*DSIN(AISP)                                     00000850
      HS(3)= DCOS(AISP)                                                 00000860
C  IF PLANAR DIFFERENCE IS INSIGNIFICANT,EXIT.                          00000870
      IF(DABS(DOT(H,HS)-1.D0).GE.1.D-10) GO TO 75                       00000880
      AKC(1)=A                                                          00000890
       AKC(2)=DABS(RA/A-1.D0)                                           00000900
      GO TO 80                                                          00000910
C  COMPUTE ARGUMENT OF PERIGEE UNIT VECTOR                              00000920
   75 AP(1) = DCOS(APF)*DCOS(AN) - DSIN(APF)*DSIN(AN)*DCOS(AI)          00000930
      AP(2) = DCOS(APF)*DSIN(AN) + DSIN(APF)*DCOS(AN)*DCOS(AI)          00000940
      AP(3) = DSIN(APF)*DSIN(AI)                                        00000950
C  COMPUTE LINE OF RELATIVE NODES VECTOR                                00000960
      CALL UCROSS(H,HS,XN)                                              00000970
C  TEST FOR NODE VECTOR DIRECTION (CLOSEST TO APOGEE)                   00000980
      TST1 = DOT(XN,AP)                                                 00000990
      IF(MAN6.LT.0) TST1=-TST1                                          00000991
      IF(TST1.LE.0.D0) GO TO 200                                        00001000
      DO 110 I=1,3                                                      00001010
  110 XN(I)= -XN(I)                                                     00001020
C  COMPUTE TRUE ANOMALY OF MANEUVER POINT                               00001030
  200 CALL CROSS(AP,XN,APX)                                             00001040
      TA = DATAN2(DOT(APX,H),DOT(AP,XN))                                00001050
      IF(TA.LT.0.D0) TA = TA + 2.D0*PII                                 00001060
      E=RA/A-1.D0                                                       00001070
C PREPARE KEPLERIAN ELEMENTS OF INITIAL (DRIFT) ORBIT                   00001080
      EL(1)=A                                                           00001090
      EL(2)=E                                                           00001100
      EL(3)=TA*R2D                                                      00001110
      EL(4)=AN*R2D                                                      00001120
      EL(5)=AI*R2D                                                      00001130
      EL(6)=APF  * R2D                                                  00001140
      IF(NMLIST.NE.0) WRITE(6,333) EL(1),EL(2),EL(5),EL(4),EL(3),EL(6)  00001150
  333 FORMAT(' ','INITIAL KEPLERIAN ORBITAL ELEMENTS (DRIFT ORBIT)      00001160
     1 BEFORE MANEUVER',/,5X,'A',19X,'E',19X,'INC',17X,'NODE',          00001170
     2 16X,'TA ',17X,'APF',/,6D20.10,/)                                 00001180
C  TRANSFORM TO CARTESIAN COORDINATES                                   00001190
      CALL ORB2X(R,V,EL,XMU,-1.D0)                                      00001200
      IF(NMLIST.NE.0) WRITE(6,334) (R(I),I=1,3),(V(I),I=1,3)            00001210
  334 FORMAT(' ','CARTESIAN POSITION AND VELOCITY',/,6(D20.10),/)       00001220
C  COMPUTE POSITION AND VELOCITY MAGNITUDES                             00001230
      RM=FNORM(R)                                                       00001240
      VM=FNORM(V)                                                       00001250
C  COMPLETE TRIAD OF LOCAL COORDINATE SYSTEM                            00001260
      CALL CROSS(HS,XN,AX)                                              00001270
C  TEST IF ECCENTRICITY OR SEMI-MAJOR AXIS CORRECTION IS SPECIFIED      00001280
      IF(ESM.LT.0.D0.AND.ASM.LT.0.D0) GO TO 500                         00001290
      IF(MAN6.GE.0) RA=RM                                               00001300
      IF(MAN6.LT.0) RP=RM                                               00001301
      AINT=(RM+ASM)/2.D0                                                00001310
      ASM=AINT                                                          00001320
      ESM=DABS(RM/ASM-1.D0)                                             00001330
C  COMPUTE FLIGHT-PATH-ANGLE                                            00001340
      IF(AMAN.EQ.0.)GO TO 249                                           00001350
C     FOR DELTA V FRACTION INPUT IN MAN3                                00001360
C      MANEUVER AT APOGEE                                               00001370
C      ASM=DESIRED SEMIMAJOR AXIS,USUALLY 42164                         00001380
C      AINT=ACHIEVABLE SEMI-MAJOR AXIS WITH AVAILABLE DELTA V.          00001390
C     CALCULATE FRACTION OF SEMI-MAJOR AXIS CHANGE ACHIEVABLE.          00001400
      AFRAC=(AINT-A)*AMAN                                               00001410
C     AINT IS NOW THE INTERMEDIATE SEMI-MAJOR AXIS                      00001420
C     ACHIEVABLE WITH THE FRACTIONAL DELTA V REQUESTED.                 00001430
      AINT=A+AFRAC                                                      00001440
C      SET DESIRED SEMI-MAJOR AXIS TO CALCULATED VALUE.                 00001450
C      CALCULATE ESM FROM ACHIEVEABLE SEMI-MAJOR AXIS                   00001460
      ASM=AINT                                                          00001470
      ESM=DABS(RM/AINT-1.D0)                                            00001480
  249  IF(ESM.EQ.0.D0) GO TO 250                                        00001490
      FLPTST=        DSQRT(ASM*(1.D0-ESM**2)/(2.D0*RM-RM*RM/ASM))       00001500
      IF(NMLIST.NE.0) WRITE(6,2) FLPTST                                 00001510
    2 FORMAT(' ','FPLTST=',D18.10/)                                     00001520
      IF(FLPTST.GT.1.D0.AND.(FLPTST-1.D0).LT.1.D-8) FLPTST=1.D0         00001530
      IF(FLPTST.GT.1.D0) GO TO 590                                      00001540
      FLPA(1)= DARCOS(FLPTST)                                           00001550
      GO TO 255                                                         00001560
  250 FLPA(1) = 0.D0                                                    00001570
  255 CONTINUE                                                          00001580
C TRANSFORM FLIGHT-PATH-ANGLES TO HS,XN,AX SYSTEM FOR BOTH POSSIBLE     00001590
C  QUADRANTS                                                            00001600
      FLPA(2)=-FLPA(1) + PII/2.D0                                       00001610
      FLPA(1)=FLPA(1) + PII/2.D0                                        00001620
      A=AINT                                                            00001630
      DO 550 J=1,2                                                      00001640
      FPA=FLPA(J)                                                       00001650
      FPA1=FPA                                                          00001660
      FPA1=FPA1*R2D                                                     00001670
      IF(NMLIST.NE.0) WRITE(6,330) FPA1,J                               00001680
  330 FORMAT(' ','FPA=',D18.10,' DEGREES FOR CASE NUMBER',I4,/)         00001690
C  COMPUTE DELTA-VELOCITIES FOR BOTH FLIGHT-PATH-ANGLES                 00001700
      VM=DSQRT(XMU*(2.D0/RM-1.D0/ASM))                                  00001710
      DO 240 I=1,3                                                      00001720
      VS(I)=VM*(XN(I)*DCOS(FPA) + AX(I)*DSIN(FPA))                      00001730
  240   DDV(I)=VS(I)-V(I)                                               00001740
      IF(NMLIST.NE.0) WRITE(6,999) XN(1),XN(2),XN(3),AX(1),AX(2),AX(3)  00001750
  999 FORMAT(' ','***XN AND AX ARRAYS',/,6D20.8,/)                      00001760
      IF(NMLIST.NE.0) WRITE(6,899) VS(1),VS(2),VS(3),DDV(1),DDV(2),     00001770
     1  DDV(3),VM                                                       00001771
  899 FORMAT(' ','***VS ARRAY,DDV ARRAY, AND VM',/,7D17.8,/)            00001780
      CALL ORB(R,VS,XMU,COMB)                                           00001790
C THE NEXT FOUR STATEMENTS ARE INCLUDED SO THAT (1) THE ORBITAL         00001800
C ELEMENTS CAN BE PUT IN DESIRED ORDER (A,E, ETC.) AND (2) SO THAT      00001810
C  THE EQUIVALENCE STATEMENT INVOLVING AKC(1) WILL CARRY THE            00001820
C  ORBITAL ELEMENTS PROPERLY                                            00001830
      COM(1)=COMB(2)                                                    00001840
      COM(2)=COMB(1)                                                    00001850
      DO 296 IP=3,6                                                     00001860
  296 COM(IP)=COMB(IP)                                                  00001870
      IF(NMLIST.NE.0) WRITE(6,336)  COMB(2),COMB(1),(COMB(IQ),IQ=3,6)   00001880
  336 FORMAT (' ','KEPLERIAN ELEMENTS IN THE FINAL ORBIT FOR 2 FPA',    00001890
     1  /,5X,'A',19X,'E',19X,'INC',17X,'NODE',16X,'APF',17X,'TA',       00001900
     2 /,6D20.10,/)                                                     00001910
      VFPA(J)=FNORM(DDV)                                                00001920
      NCONF=1                                                           00001930
      DO 222 IZ=1,3                                                     00001940
  222  UVFPA(IZ)=DDV(IZ)/VFPA(J)                                        00001950
       CALL SARA(UVFPA,RA1,DEC1,NCONF)                                  00001960
      RA1=RA1*R2D                                                       00001970
      DEC1=DEC1*R2D                                                     00001980
       IF(NMLIST.NE.0) WRITE(6,650) RA1,DEC1                            00001990
  650  FORMAT(' ','RA=',D18.10,3X,'DEC=',D18.10,3X,'COMBINED MANEUVER'/)00002000
C  THE NEXT STATEMENT CHECKS TO SEE IF THE FLIGHT PATH ANGLE IS 90      00002010
C  DEGREES.  IF SO, IT IS ONLY NECESSARY TO GO THROUGH THE DO 550       00002020
C  DO LOOP ONE TIME.                                                    00002030
      IF(DABS(FPA1-90.0).GT.0.0001) GO TO 550                           00002040
      VIN=VFPA(J)                                                       00002050
      GO TO 554                                                         00002060
  550 CONTINUE                                                          00002070
C  ADOPT MINIMUM VELOCITY VALUE                                         00002080
      VIN =DMIN1(VFPA(1),VFPA(2))                                       00002090
  554 DVS = DVS + VIN                                                   00002100
      GO TO 600                                                         00002110
  500 CONTINUE                                                          00002120
C  COMPUTE PURELY AN INCLINATION AND/OR NODE CORRECTION                 00002130
C  COMPUTE FLIGHT PATH ANGLE                                            00002140
      CALL CROSS(XN,V,XNV)                                              00002150
      FPA=DATAN2(DOT(XNV,H),DOT(XN,V))                                  00002160
      FPA2=FPA*R2D                                                      00002170
      IF(NMLIST.NE.0) WRITE(6,337) FPA2                                 00002180
  337 FORMAT(' ','FPA=',D18.10,' DEGREES--INCLINATION AND NODE          00002190
     1  CHANGE ONLY',/)                                                 00002200
C  COMPUTE DELTA-VELOCITY                                               00002210
      DO 220 I=1,3                                                      00002220
      VS(I)=VM*(XN(I)*DCOS(FPA) + AX(I)*DSIN(FPA))                      00002230
  220 DDV(I)=VS(I)-V(I)                                                 00002240
      VIN=FNORM(DDV)                                                    00002250
       NCONF=1                                                          00002260
      DO 221 I=1,3                                                      00002270
       UVIN(I)=DDV(I)/VIN                                               00002280
  221  CONTINUE                                                         00002290
      CALL SARA(UVIN,RA2,DEC,NCONF)                                     00002300
      RA2=RA2*R2D                                                       00002310
      DEC=DEC*R2D                                                       00002320
      IF(NMLIST.NE.0) WRITE(6,700) RA2,DEC                              00002330
  700 FORMAT(' ','RA=',D18.10,3X,'DEC=',D18.10,3X,'  I, NODE CHANGE     00002340
     *  ONLY ',/)                                                       00002350
      DVS=DVS + VIN                                                     00002360
      GO TO 600                                                         00002370
  590  WRITE(6,591)                                                     00002380
  591 FORMAT('1',' INPUT ERROR - DESIRED ORBIT DOES NOT INTERSECT ORIGIN00002390
     .AL ORBIT - CHECK ASM,ESM '/)                                      00002400
  600 CONTINUE                                                          00002410
      IF(ASM.LT.0.) GO TO 43                                            00002420
      AKC(1)=COMB(2)                                                    00002430
      AKC(2)=COMB(1)                                                    00002440
   43 ESM=ES1                                                           00002450
      ASM=AS1                                                           00002460
   80 CONTINUE                                                          00002470
      RETURN                                                            00002480
      END                                                               00002490
C          DATA SET AMUD       AT LEVEL 004 AS OF 06/19/79
C          DATA SET AMUD       AT LEVEL 003 AS OF 05/15/79              00001
C          DATA SET AMUD       AT LEVEL 001 AS OF 04/04/78              00002
C                                                                       00003
C  REAL FUNCTION AMUD*8(X,Y)                                            00004
C                                                                       00005
C  AMUD TAKES AN ANGLE X AND CONVERTS IT TO AN ANGLE LYING              00006
C  BETWEEN 0 AND 2*PI.                                                  00007
C                                                                       00008
C  ARGUMENTS IN THE CALLING SEQUENCE ARE DEFINED AS                     00009
C  FOLLOWS:                                                             00010
C                                                                       00011
C     ARGUMENT       TYPE   I/O         DEFINITION                      00012
C                                                                       00013
C         X          R*8     I          INPUT ANGLE                     00014
C         Y          R*8     I          IN MONITOR, Y=2*PI              00015
C         AMUD       R*8     O          THE ANGLE WHICH LIES BETWEEN 0  00016
C                                       AND 2*PI.                       00017
C                                                                       00018
C                                                                       00019
C  AMUD IS CALLED BY THE FOLLOWING SUBROUTINES:                         00020
C                                                                       00021
C     CONBR                                                             00022
C                                                                       00023
C  NO SUBROUTINES ARE CALLED BY AMUD                                    00024
C                                                                       00025
C  AMUD NEITHER USES NOR ALTERS VARIABLES IN COMMON.                    00026
C  ALL INPUT AND OUTPUT IS THROUGH THE CALLING SEQUENCE.                00027
C                                                                       00028
C                                                                       00029
      REAL FUNCTION AMUD*8(X,Y)                                         00030
      IMPLICIT REAL*8(A-H,O-Z)                                          00031
      IF (Y.EQ.0.D0) GO TO 10                                           00032
C  K IS THE TRUNCATED RATIO OF X/Y.  ANGLE X=AMUD + 2*PI, WHERE         00033
C  AMUD IS THE DESIRED ANGLE BETWEEN 0 AND 2*PI                         00034
      K = X/Y                                                           00035
      AMUD = X-K*Y                                                      00036
      RETURN                                                            00037
   10 AMUD = 0.D0                                                       00038
      RETURN                                                            00039
      END                                                               00040
      SUBROUTINE AP(AS,ES,A,RA,RP,VAN1,VA,VAN2,VPS,XMU)                 00000010
C                                                                       00000020
C  SUBROUTINE AP(AS,ES,A,RA,RP,VAN1,VA,VAN2,VPS,XMU)                    00000030
C                                                                       00000040
C  THE PURPOSE OF AP IS TO SIMULATE AN APOGEE MANEUVER FOLLOWED         00000050
C  BY A PERIGEE MANEUVER, IN WHICH ONLY THE SEMI-MAJOR AXIS AND         00000060
C  THE ECCENTRICITY ARE ALTERED, IN ORDER TO DETERMINE THE              00000070
C  VELOCITY REQUIREMENTS FOR THE MANEUVERS.                             00000080
C  THIS SUBPROGRAM ALSO HAS THE OPTION IN WHICH A PERIGEE BURN          00000081
C  ONLY CAN BE DESIGNATED.                                              00000082
C                                                                       00000090
C  ARGUMENTS IN THE CALLING SEQUENCE ARE DEFINED AS FOLLOWS:            00000100
C                                                                       00000110
C  ARGUMENT   TYPE   I/O        DEFINITIONS                             00000120
C                                                                       00000130
C     AS      R*8     I     DESIRED SEMI-MAJOR AXIS                     00000140
C     ES      R*8     I     DESIRED ECCENTRICITY                        00000150
C     A       R*8     I     SEMI-MAJOR AXIS BEFORE MANEUVERS BEGIN      00000160
C     RA      R*8     I     RADIUS OF APOGEE BEFORE MANEUVERS BEGIN     00000170
C     RP      R*8     I     RADIUS OF PERIGEE BEFORE MANEUVERS BEGIN    00000180
C     VAN1    R*8     O     APOGEE VELOCITY AFTER APOGEE MANEUVER       00000190
C     VA      R*8     O     APOGEE VELOCITY BEFORE APOGEE MANEUVER      00000200
C     VAN2    R*8     O     PERIGEE VELOCITY BEFORE PERIGEE MANEUVER    00000210
C     VPS     R*8     O     PERIGEE VELOCITY AFTER PERIGEE MANEUVER     00000220
C     XMU     R*8     I     GRAVITATIONAL CONSTANT FOR THE EARTH        00000230
C                                                                       00000240
C  AP IS CALLED BY THE FOLLOWING SUBROUTINES:                           00000250
C                                                                       00000260
C     BDELVS                                                            00000270
C                                                                       00000280
C  AP CALLS NO SUBROUTINES                                              00000290
C                                                                       00000300
C  AP NEITHER USES NOR ALTERS VARIABLES IN COMMON. ALL INPUT            00000310
C  AND OUTPUT IS THROUGH THE CALLING SEQUENCE.                          00000320
C                                                                       00000330
C                                                                       00000340
      IMPLICIT REAL*8 (A-H,O-Z)                                         00000350
      COMMON/ELEM/AKC(12)                                               00000360
      IF(AKC(1).EQ.0.D0) GO TO 47                                       00000370
       A=AKC(1)                                                         00000380
   47 RP=2.D0*A-RA                                                      00000390
C  THIS STATEMENT CHECKS TO SEE IF ONLY A PERIGEE BURN IS               00000391
C  NEEDED.  IF(DABS(RP-AS)IS LESS THAN .001, THEN A                     00000392
C  PERIGEE BURN ONLY IS NEEDED.                                         00000393
      IF(DABS(RP-AS).GT.0.001) GO TO 701                                00000400
      RPS=AS                                                            00000410
      ANA=A                                                             00000420
      VAN1=1.                                                           00000430
      VA=VAN1                                                           00000440
      GO TO 702                                                         00000450
C  APOGEE MANEUVER CALCULATIONS BEGIN                                   00000460
C  RPS IS THE DESIRED RADIUS OF PERIGEE AFTER THE MANEUVER IS           00000470
C  COMPLETED                                                            00000480
  701 RPS=AS*(1.D0-DABS(ES))                                            00000490
C  ANA IS THE INTERMEDIATE SEMI-MAJOR AXIS ACHIEVED AFTER THE           00000500
C  APOGEE MANEUVER.                                                     00000510
      ANA=(RA+RPS)/2.D0                                                 00000520
      VA=DSQRT(XMU*(2.D0/RA-1.D0/A))                                    00000530
      VAN1=DSQRT(XMU*(2.D0/RA-1.D0/ANA))                                00000540
C  PERIGEE MANEUVER CALCULATIONS BEGIN.                                 00000550
  702 VPS=DSQRT(XMU*(2.D0/RPS-1.D0/AS))                                 00000560
      VAN2=DSQRT(XMU*(2.D0/RPS-1.D0/ANA))                               00000570
      AKC(1)=AS                                                         00000580
       AKC(2)=ES                                                        00000590
      RETURN                                                            00000600
      END                                                               00000610
C          DATA SET ARKTNS     AT LEVEL 002 AS OF 06/22/79
C          DATA SET ARKTNS     AT LEVEL 001 AS OF 04/04/78              00001
      REAL FUNCTION ARKTNS*8 (N,X,Y)                                    00002
C                                                                       00003
C                                                                       00004
C     REAL FUNCTION ARKTNS*8 (N,X,Y)                                    00005
C                                                                       00006
C                                                                       00007
C                                                                       00008
C     THE PURPOSE OF ARKTNS IS TO COMPUTE THE 4-QUADRANT                00009
C         ARCTANGENT OF Y/X IN RADIANS.                                 00010
C                                                                       00011
C                                                                       00012
C                                                                       00013
C     ARGUMENTS IN THE CALLING SEQUENCE ARE DEFINED AS FOLLOWS.         00014
C                                                                       00015
C         ARGUMENTS  TYPE    I/O        DEFINITION                      00016
C                                                                       00017
C          N         I*4      I      N=360, THE ANGLE LIES IN THE       00018
C                                           RANGE (0,360) DEGREES       00019
C                                    N=180, THE ANGLE LIES IN THE       00020
C                                           RANGE (-180,180) DEGREES    00021
C          X         R*8      I      X COORDINATE OF RADIUS VECTOR      00022
C          Y         R*8      I      Y COORDINATE OF RADIUS VECTOR      00023
C          ARKTNS    R*8      O      ANGLE BETWEEN X-AXIS AND           00024
C                                        RADIUS VECTOR (RADIANS)        00025
C                                                                       00026
C                                                                       00027
C                                                                       00028
C     ARKTNS IS CALLED BY THE FOLLOWING SUBROUTINES.                    00029
C                                                                       00030
C         CVPROP    ORB       ORB2X     STEPD                           00031
C                                                                       00032
C                                                                       00033
C     NO SUBROUTINES ARE CALLED BY ARKTNS.                              00034
C                                                                       00035
C                                                                       00036
C                                                                       00037
C     THE VARIABLES APPEARING IN COMMON BLOCKS ARE TABULATED BELOW.     00038
C                                                                       00039
C         COMMON VARIABLES USED                                         00040
C                                                                       00041
C         XPI                                                           00042
C                                                                       00043
C                                                                       00044
C                                                                       00045
C                                                                       00046
      IMPLICIT REAL*8(A-H,O-Z)                                          00047
C  COMPUTES 4-QUADRANT ARCTANGENT OF Y/X IN RADIANS                     00048
C  N=360  ANGLE LIES IN RANGE (0,360) DEG                               00049
C  N=180  ANGLE LIES IN RANGE (-180,180) DEG                            00050
      COMMON /CONST/ S2LB,D2R,XPI,R2D,F2KM,XKM2F,G0                     00051
C                                                                       00052
      TPI=2.*XPI                                                        00053
      XA=DABS(X)                                                        00054
      YA=DABS(Y)                                                        00055
      IF(XA-YA)1,1,2                                                    00056
    1 Z=X/YA                                                            00057
      GO TO 3                                                           00058
    2 Z=Y/XA                                                            00059
      YA=XA                                                             00060
    3 D=DSQRT(1.0D0+Z*Z)                                                00061
      YA=YA*D+X                                                         00062
      IF(YA)4,4,5                                                       00063
C  THE ANGLE IS 180 DEGREES, IF YA=0.                                   00064
    4 ARKTNS=TPI/2.0D0                                                  00065
      GO TO 6                                                           00066
    5 ARKTNS=2.0D0*DATAN(Y/YA)                                          00067
C  N NOT EQUAL TO 180 INDICATES THAT THE DESIRED ANGLE LIES BETWEEN     00068
C  0 DEGREES AND 360 DEGREES.                                           00069
    6 IF(N-180)7,9,7                                                    00070
    7 IF(ARKTNS)8,9,9                                                   00071
C  IN THE CASE WHEN ARKTNS < 0, 2*PI IS ADDED SO THAT ARKTNS WILL LIE   00072
C  BETWEEN 0 DEGREES AND 360 DEGREES.                                   00073
    8 ARKTNS=ARKTNS+TPI                                                 00074
    9 RETURN                                                            00075
      END                                                               00076
C          DATA SET ARRANG     AT LEVEL 002 AS OF 06/20/79
C          DATA SET ARRANG     AT LEVEL 001 AS OF 04/04/78              00001
C                                                                       00002
      SUBROUTINE ARRANG(X,N)                                            00003
C                                                                       00004
C                                                                       00005
C     SUBROUTINE ARRANG(X,N)                                            00006
C                                                                       00007
C                                                                       00008
C                                                                       00009
C     THE PURPOSE OF ARRANG IS TO ARRANGE THE VALUES OF AN ARRAY OF N   00010
C         NUMBERS INTO ASCENDING ORDER (X(1)=LOWEST VALUE, X(N)=HIGHEST 00011
C         VALUE).                                                       00012
C                                                                       00013
C                                                                       00014
C                                                                       00015
C     ARGUMENTS IN THE CALLING SEQUENCE ARE DEFINED AS FOLLOWS.         00016
C                                                                       00017
C         ARGUMENT   TYPE    I/O        DEFINITION                      00018
C                                                                       00019
C          X         R*4     I/O     ARRAY TO BE RE-ARRANGED            00020
C          N         I*4      I      NUMBER OF ELEMENTS IN ARRAY X      00021
C                                                                       00022
C                                                                       00023
C                                                                       00024
C     ARRANG IS CALLED BY THE FOLLOWING SUBROUTINES.                    00025
C                                                                       00026
C         STATS                                                         00027
C                                                                       00028
C                                                                       00029
C                                                                       00030
C                                                                       00031
C                                                                       00032
C     NO SUBROUTINES ARE CALLED BY ARRANG.                              00033
C                                                                       00034
C                                                                       00035
C                                                                       00036
C     ARRANG NEITHER USES NOR ALTERS VARIABLES IN COMMON. ALL INPUT AND 00037
C         OUTPUT IS THROUGH THE CALLING SEQUENCE.                       00038
C                                                                       00039
C                                                                       00040
C                                                                       00041
      IMPLICIT REAL*8(A-H,O-Z)                                          00042
      REAL*4 X(2)                                                       00043
      DO  30 I = 1, N                                                   00044
      J = I                                                             00045
      DO  20 K = J, N                                                   00046
      IF(X(I).GT.X(K)) GO TO 10                                         00047
      GO TO 20                                                          00048
   10 CONTINUE                                                          00049
C  WHEN X(I) > X(K), THE VALUES OF X(I) AND X(K) ARE INTERCHANGED       00050
C  SO THAT X(I) ALWAYS HAS THE SMALLEST VALUE OF THE X VALUES           00051
C  ENCOUNTERED IN THE SWEEP THROUGH THE DO 20 DO LOOP.                  00052
      TEMP = X(K)                                                       00053
      X(K) = X(I)                                                       00054
      X(I) = TEMP                                                       00055
   20 CONTINUE                                                          00056
   30 CONTINUE                                                          00057
      RETURN                                                            00058
      END                                                               00059
C          DATA SET BARN1      AT LEVEL 003 AS OF 06/20/79
C          DATA SET BARN1      AT LEVEL 002 AS OF 05/18/79              00001
C                                                                       00002
C                                                                       00003
      REAL FUNCTION BARN1*8(I,IKEY,IFRN,SD)                             00004
C                                                                       00005
C                                                                       00006
C     REAL FUNCTION BARN1*8 (I,IKEY,IFRN,SD)                            00007
C                                                                       00008
C                                                                       00009
C                                                                       00010
C     THE PURPOSE OF BARN1 IS TO COMPUTE ONE RANDOM NUMBER FROM AN      00011
C         APPROXIMATE GAUSSIAN DISTRIBUTION OR FROM A UNIFORM           00012
C         DISTRIBUTION                                                  00013
C                                                                       00014
C                                                                       00015
C                                                                       00016
C     ARGUMENTS IN THE CALLING SEQUENCE ARE DEFINED AS FOLLOWS.         00017
C                                                                       00018
C         ARGUMENT   TYPE    I/O        DEFINITION                      00019
C                                                                       00020
C          I         I*4      I      I.LT.0, RANDOM NUMBER COMES FROM   00021
C                                            AN APPROXIMATE GAUSSIAN    00022
C                                            DISTRIBUTION               00023
C                                    I.GE.0, RANDOM NUMBER COMES FROM   00024
C                                            A UNIFORM DISTRIBUTION     00025
C          IKEY      I*4      I      IKEY=-1,DEFAULT VALUE OF IFRN IS   00026
C                                            USED                       00027
C                                    IKEY=0, VALUE OF IFRN IS INPUT     00028
C          IFRN      I*4      I      STARTING VALUE FOR RANDOM NUMBER   00029
C                                        GENERATOR                      00030
C          SD        R*8      I      DESIRED STANDARD DEVIATION FOR     00031
C                                        THE GAUSSIAN DISTRIBUTION      00032
C                                        (THE MEAN IS SET TO ZERO)      00033
C          BARN1     R*8      O      RANDOM NUMBER                      00034
C                                                                       00035
C                                                                       00036
C                                                                       00037
C     BARN1 IS CALLED BY THE FOLLOWING SUBROUTINES                      00038
C                                                                       00039
C         PREP      RANDOM      RANTAR                                  00040
C                                                                       00041
C                                                                       00042
C     THE FOLLOWING SUBROUTINES ARE CALLED BY BARN1.                    00043
C                                                                       00044
C         GAUSS     RANDU                                               00045
C                                                                       00046
C                                                                       00047
C                                                                       00048
C     BARN1 NEITHER USES NOR ALTERS VARIABLES IN COMMON. ALL            00049
C         INPUT AND OUTPUT IS THROUGH THE CALLING SEQUENCE.             00050
C                                                                       00051
C                                                                       00052
C                                                                       00053
C                                                                       00054
      IMPLICIT REAL*8(A-H,O-Z)                                          00055
C-----------------------------------------------------------------------00056
C      SD------- THE DESIRED STANDARD DEVIATION                         00057
C      AMEAN--- THE DESIRED MEAN                                        00058
C      H--------- THE POPULATION SIZE                                   00059
C                                                                       00060
      DATA AMEAN/0.D0/                                                  00061
      DATA IHERE/12787/                                                 00062
      DATA H/36.D0/                                                     00063
C  THIS TEST DETERMINES WHETHER OR NOT THE STANDARD DEFAULT VALUE       00064
C  (12787) OF IFRN IS TO BE USED--IF IKEY < 0 .                         00065
      IF (IKEY)5,4,4                                                    00066
    4 IHERE=IFRN                                                        00067
      IKEY=-1                                                           00068
    5 IF(I) 6,7,7                                                       00069
C  SUBROUTINE GAUSS CALCULATES THE DESIRED RANDOM NUMBER (VAL) FROM     00070
C  AN APPROXIMATELY NORMAL DISTRIBUTION OF NUMBERS                      00071
    6 CALL GAUSS(IHERE,SD,AMEAN,VAL,H)                                  00072
C DELETION OF IFRN=IHERE                                                00073
      GO TO 8                                                           00074
C  RANDU CALCULATES THE DESIRED RANDOM NUMBER BETWEEN 0 AND 1 FROM      00075
C  A NORMAL DISTRIBUTION OF NUMBERS.                                    00076
    7 CALL RANDU(IHERE,IFRN,VAL)                                        00077
      IHERE=IFRN                                                        00078
    8 BARN1=VAL                                                         00079
      RETURN                                                            00080
      END                                                               00081
C          DATA SET BLOCK      AT LEVEL 014 AS OF 03/22/79              00000000
      BLOCK DATA                                                        00000010
C                                                                       00000020
C                                                                       00000030
C     SUBROUTINE BLOCK DATA                                             00000040
C                                                                       00000050
C                                                                       00000060
C                                                                       00000070
C     THE PURPOSE OF BLOCK DATA IS TO INITIALIZE VARIABLES IN COMMON    00000080
C         BLOCKS BY USE OF DATA STATEMENTS.                             00000090
C                                                                       00000100
C                                                                       00000110
C                                                                       00000120
C     THERE ARE NO ARGUMENTS IN THE CALLING SEQUENCE. ALL OUTPUT        00000130
C         VARIABLES ARE PASSED THROUGH COMMON.                          00000140
C                                                                       00000150
C                                                                       00000160
C                                                                       00000170
C     NO SUBROUTINES CALL BLOCK DATA                                    00000180
C                                                                       00000190
C                                                                       00000200
C                                                                       00000210
C     NO SUBROUTINES ARE CALLED BY BLOCK DATA.                          00000220
C                                                                       00000230
C                                                                       00000240
C                                                                       00000250
C     THE VARIABLES APPEARING IN COMMON BLOCKS ARE TABULATED BELOW.     00000260
C                                                                       00000270
C         COMMON VARIABLES INITIALIZED                                  00000280
C                                                                       00000290
C         AINPUT(20)DRTOL     FIS       IP3COR    PITCH1    WAH         00000300
C         AINSY1    DTB1      FNS       IP4COR    P1        WC1         00000310
C         AINTR1    DTC1      F2KM2F    IP5COR    RA        W1          00000320
C         AIS       DT11      GO        IP6COR    R2D       WWC1(100)   00000330
C         ALAMD1    DT21      ICOV(25)  ISCFLG    SDAY      X11(6)      00000340
C         ALD       DT31      ICVOUT    ITOPT     SIGB1(3)  XISPH       00000350
C         ALF       DT41      IFLAG     ITPSTR    STAF1     XISP1       00000360
C         AL1       DT51      IFRN      IW        S2LB      XKM2F       00000370
C         ANOM      DT61      IGUID1    LEG       TAMAN     XMU         00000380
C         AP        DVIN1     IHIST(25) LU8       TCOV      XMU2        00000390
C         AS        DVN1      IKEY      LU9       TERR      XP1         00000400
C         ASM       D2R       IOP       LU16      THR1(100) XT1(6)      00000410
C         DEC       EL(6)     IPCOOR    LU20      THRUS1    X21(6)      00000420
C         DELNO1    ES        IP1COR    NAMES(6)  TOLR      YAW1        00000430
C         DIS       ESM       IP2COR    NCONF     TUB       ZDELT       00000440
C         DNS                                                           00000450
C                                                                       00000460
C                                                                       00000470
C                                                                       00000480
      IMPLICIT REAL*8(A-H,O-Y)                                          00000490
      REAL*8 NAMES                                                      00000500
      COMMON /GENRL/ P1,PI(6,6),XII(6),XMU,NAMES(6),PITCHI,YAWI,WI,     00000510
     A P1I(6,6),P2I(6,6),P3I(6,6),P4I(6,6),P5I(6,6),P6I(6,6),TOLR(50),  00000520
     * THRUSI,SIGBI(3),ZDELT,ZUB(3,50),                                 00000530
     B IP1COR,IP2COR,IP3COR,IP4COR,IP5COR,IP6COR,                       00000540
     1 ICOV(50),IHIST(50),IPCOOR,ITPSTR,NCONF,MODE                      00000550
     2 ,IKEY,IFRN                                                       00000560
C                                                                       00000570
      COMMON /PKMCOM/ XISPJ,DVINJ,DECPKM,RAPKM,TERRJ,SIGBJ(2),          00000580
     *DELNOJ,AINSYJ,ASJ,TAM,LEGJ,IGUIDJ,ITO,JPKM                        00000590
      COMMON /GEO/ AINSYI,AINTRI,AIS,ALAMDI,ANOM,AP,AS,ASM,             00000600
     1 DELNOI,DRTOL,DSMA,DVINI,DVNI,                                    00000610
     2EL(6),ES,ESM,SDAY,SNODE,STAFI,TCOV,TAMAN,                         00000620
     3 TERR,TUB,WAH,XB(6),XISPH,XISPI,DIS,FIS,DNS,FNS,ALI,ALF,ALD,      00000630
     4 IGUIDI,IOP,IW,LEG,IFLAG,ITOPT,ISCFLG,SCNPAR(3,5)                 00000640
      COMMON /CONST/ S2LB,D2R,XPI,R2D,F2KM,XKM2F,G0                     00000650
      COMMON/CVPR/ DTBI,DTCI,WCI,RA,DEC,THRI(100),WWCI(100),NBURN,      00000660
     1 ICVOUT                                                           00000670
      COMMON/COMT/ DT1I,DT2I,DT3I,DT4I,DT5I,DT6I,XTI(6),X2I(6),XMU2     00000680
      COMMON /INPUT/ AINPUT(20)                                         00000690
      COMMON/LUS/LU8,LU9,LU16,LU20,LU21,LU25                            00000700
      COMMON/LSCAN/LUNIT                                                00000710
      COMMON/TSCAN/WAPKM,TAKMAN,AKMWT,ISCANT(50),IUP,ISCAN(5)           00000720
      COMMON/SCNTY/TITLE(16),VAR(5)                                     00000730
      COMMON/ELEM/AKC(12)                                               00000740
      COMMON/MANINP/AMAN(6),VREOR,AKMIN                                 00000741
      COMMON/NOPRNT/NMLIST                                              00000742
      DATA AINPUT /20*0.D0/                                             00000750
      DATA XISPJ/10.D0/,DVINJ/0.D0/,DECPKM/0.D0/,RAPKM/0.D0/,           00000760
     * TERRJ/0.D0/,SIGBJ/2*0.D0/,DELNOJ/0.D0/,AINSYJ/10.D0/,            00000770
     * ASJ/1000.D0/,TAM/0.D0/                                           00000780
      DATA LEGJ/1/,IGUIDJ/1/,ITO/0/,JPKM/1/                             00000790
      DATA TOLR/50*0.D0/                                                00000800
      DATA NAMES/3HECC,3HSMA,3HINC,5HOMEGA,4HARGP,5HTHETA/              00000810
      DATA ICOV,IHIST,IPCOOR,ITPSTR,NCONF /100*0,2*1,0/                 00000820
      DATA IP1COR,IP2COR,IP3COR,IP4COR,IP5COR,IP6COR/6*1/               00000830
      DATA P1,XII,XMU,ZDELT/3.14159265D0,6*0.D0,                        00000840
     1 398603.2D0,0./                                                   00000850
      DATA IGUIDI,IOP,ITPSTR,IW,LEG,IFLAG /0,0,1,1,1,0/                 00000860
      DATA AINSYI,AINTRI,AIS,ALAMDI,    ANOM,AS,ASM                     00000870
     1 /2*0.D0,-1.D0,3*0.D0,-1.D0/                                      00000880
      DATA DELNOI,DRTOL,DTBI,DTCI,DVINI,DVNI                            00000890
     1  /0.D0,9999999.D9,3*0.D0,-1.D0/                                  00000900
      DATA EL,ES,ESM /8*0.D0/                                           00000910
      DATA PITCHI,SDAY,SIGBI,       TCOV,THRUSI  /0.D0,                 00000920
     1 86164.096D0,3*0.D0,360.9856472D0,0.D0/                           00000930
      DATA WAH,WCI,WI  /3*0.D0/                                         00000940
      DATA  ISCAN,SCNPAR/5*17,15*0.D0/                                  00000950
      DATA XISPH,XISPI,YAWI    /220.D0,2*0.D0/                          00000960
      DATA TUB,AP,STAFI/-1.D0,0.D0,244.D0/                              00000970
      DATA RA,DEC,THRI,WWCI/202*0.D0/                                   00000980
      DATA XMU2,DT1I,DT2I,DT3I,DT4I,DT5I,DT6I,                          00000990
     1XTI,X2I/ 132712499000.D0,6*0.D0,12*0.D0/                          00001000
      DATA ICVOUT,IFLAG/2*0/                                            00001010
      DATA S2LB/.004448221615260D0/                                     00001020
      DATA D2R/ .017453292519943D0/                                     00001030
      DATA XPI/ 3.141592653589793D0/                                    00001040
      DATA R2D/ 57.2957795131D0/                                        00001050
      DATA F2KM/ 0.0003048D0/                                           00001060
      DATA XKM2F/ 3280.839895013D0/                                     00001070
      DATA G0/ 32.1740484744D0/                                         00001080
      DATA TERR/0.D0/,ITOPT/0/,IKEY/-1/,IFRN/12787/                     00001090
      DATA DIS,FIS,DNS,FNS/4*0.D0/                                      00001100
      DATA ALI,ALF,ALD,ISCFLG/-90.D0,90.D0,5.D0,0/                      00001110
      DATA TAMAN/000.D0/                                                00001120
      DATA LU8,LU9,LU16,LU20,LU21,LU25/8,9,16,20,0,25/                  00001130
      DATA IUP/0/                                                       00001140
      DATA ISCANT/50*0/                                                 00001150
      DATA LUNIT/26/                                                    00001160
      DATA AMAN,VREOR/6*0.D0,.01/                                       00001161
            DATA TITLE/'DVINJ   ','WAPKM   ','RAPKM   ','DECPKM',       00001170
     1 'EL(1)  ','EL(2)  ','EL(5)  ','TAMAN   ',                        00001180
     2  'EL(4)  ','DELNOI  ','DVINI   ','TAKMAN  ',                     00001190
     3  'AKMWT   ','PITCHI  ','YAWI    ','AINSYI  '/                    00001200
      DATA AKC/12*0.D0/                                                 00001210
      DATA NMLIST/0/                                                    00001211
       DATA AKMIN/1.D0/                                                 00001212
      END                                                               00001220
C          DATA SET BURNST     AT LEVEL 002 AS OF 06/22/79
C          DATA SET BURNST     AT LEVEL 001 AS OF 04/04/78              00001
C                                                                       00002
      SUBROUTINE BURNST(XTR,VTR,XT,VT,W2,DW2,WC2,ALPH,TV,DT,THRUS,YA,GMU00003
     2 )                                                                00004
C                                                                       00005
C                                                                       00006
C     SUBROUTINE BURNST (XTR,VTR,XT,VT,W2,DW2,WC2,ALPH,TV,              00007
C                        DT,THRUS,YA,GMU)                               00008
C                                                                       00009
C                                                                       00010
C                                                                       00011
C     THE PURPOSE OF BURNST IS TO PROPAGATE THE STATE VECTOR THROUGH    00012
C         THE APOGEE BURN.                                              00013
C                                                                       00014
C                                                                       00015
C                                                                       00016
C     ARGUMENTS IN THE CALLING SEQUENCE ARE DEFINED AS FOLLOWS.         00017
C                                                                       00018
C         ARGUMENT   TYPE    I/O        DEFINITION                      00019
C                                                                       00020
C          XTR(3)    R*8      I      INERTIAL POSITION VECTOR PRIOR     00021
C                                        TO THE APOGEE BURN             00022
C          VTR(3)    R*8      I      INERTIAL VELOCITY VECTOR PRIOR     00023
C                                        TO THE APOGEE BURN             00024
C          XT(3)     R*8      O      INERTIAL POSITION VECTOR           00025
C                                        AFTER THE APOGEE BURN          00026
C          VT(3)     R*8      O      INERTIAL VELOCITY VECTOR           00027
C                                        AFTER THE APOGEE BURN          00028
C          W2        R*8      I      INITIAL SPACECRAFT WEIGHT (POUNDS) 00029
C          DW2       R*8      I      INCREMENT TO BE ADDED TO W2        00030
C                                        BEFORE THE BURN TIME (POUNDS)  00031
C                                                                       00032
C          WC2       R*8      I      FUEL USED DURING THE               00033
C                                        APOGEE BURN (POUNDS)           00034
C                                                                       00035
C          ALPH      R*8      I      THRUST PITCH ANGLE (DEGREES)       00036
C                                                                       00037
C          TV(3)     R*8      O      INERTIAL THRUST VECTOR             00038
C                                        (KILOGRAM-KILOMETER PER        00039
C                                         SECOND SQUARED)               00040
C                                                                       00041
C          DT        R*8      I      BURN TIME                          00042
C                                                                       00043
C          THRUS     R*8      I      THRUST MAGNITUDE (POUNDS)          00044
C                                                                       00045
C          YA        R*8      I      THRUST VECTOR YAW ANGLE (DEGREES)  00046
C                                                                       00047
C          GMU       R*8      I      GRAVITATIONAL CONSTANT TIMES THE   00048
C                                        MASS OF THE EARTH              00049
C                                        (KILOMETERS CUBED PER          00050
C                                         SECOND SQUARED)               00051
C                                                                       00052
C                                                                       00053
C                                                                       00054
C     BURNST IS CALLED BY THE FOLLOWING SUBROUTINES.                    00055
C                                                                       00056
C         CVPROP                                                        00057
C                                                                       00058
C                                                                       00059
C     THE FOLLOWING SUBROUTINE IS CALLED BY BURNST.                     00060
C                                                                       00061
C         CROSS                                                         00062
C                                                                       00063
C                                                                       00064
C                                                                       00065
C     THE FOLLOWING FUNCTION SUBPROGRAM IS CALLED BY BURNST.            00066
C                                                                       00067
C         FNORM                                                         00068
C                                                                       00069
C                                                                       00070
C                                                                       00071
C     THE VARIABLES APPEARING IN COMMON BLOCKS ARE TABULATED BELOW.     00072
C                                                                       00073
C         COMMON VARIABLES USED                                         00074
C                                                                       00075
C         S2LB      D2R       XPI                                       00076
C                                                                       00077
C                                                                       00078
C                                                                       00079
C                                                                       00080
C THIS SUBROUTINE PROPAGATES THE STATE VECTOR THRU THE BURN             00081
C WGT IS INPUT IN     LBS          AND WILL BE DIVIDED BY G             00082
C THRUST MUST BE IN SAME UNITS AS WGT                                   00083
      IMPLICIT REAL*8(A-H,O-Z)                                          00084
      COMMON /CONST/ S2LB,D2R,XPI,R2D,F2KM,XKM2F,G0                     00085
      DIMENSION XTR(3),VTR(3),XT(3),VT(3),TV(3),HTR(3),CTR(3)           00086
C  HTR IS THE ANGULAR MOMENTUM PER UNIT MASS VECTOR PRIOR TO APOGEE BURN00087
      CALL CROSS(XTR,VTR,HTR)                                           00088
      CALL CROSS(HTR,VTR,CTR)                                           00089
      CMAG = FNORM(CTR)                                                 00090
      VMAG = FNORM(VTR)                                                 00091
      HMAG = FNORM(HTR)                                                 00092
10    ALPHA=ALPH*D2R                                                    00093
      BETA=XPI/2.+ALPHA                                                 00094
      COSAL = DCOS(ALPHA)                                               00095
      COSBE = DCOS(BETA)                                                00096
      YAW=YA     *D2R                                                   00097
      SYAW = DSIN(YAW)                                                  00098
      CYAW = DCOS(YAW)                                                  00099
C  CONVERT LBS TO (KG-KM / SEC**2)                                      00100
      W1=W2*S2LB                                                        00101
      DW1=DW2*S2LB                                                      00102
      WC1=WC2*S2LB                                                      00103
      THRUST=THRUS*S2LB                                                 00104
C  COMPUTE THE INERTIAL THRUST VECTOR, TV                               00105
      DO 1 I = 1,3                                                      00106
1     TV(I) = THRUST*(COSAL*CYAW*VTR(I)/VMAG + COSBE*CYAW*CTR(I)/CMAG   00107
     1 + SYAW*HTR(I)/HMAG)                                              00108
C  G IS THE ACCELERATION DUE TO GRAVITY IN KM/SEC/SEC                   00109
      G = 9.80665D-3                                                    00110
C  W IS THE INITIAL SPACECRAFT MASS; DW IS THE MASS INCREMENT ADDED TO  00111
C  W BEFORE BURN TIME; WC IS THE FUEL MASS USED DURING APOGEE BURN.     00112
      W = W1/G                                                          00113
      DW = DW1/G                                                        00114
      WC = WC1/(G*DT)                                                   00115
      TEMP = DLOG(1.D0+WC*DT/(W+DW))                                    00116
      RMAG = FNORM(XTR)                                                 00117
   76 CONTINUE                                                          00118
      DO 2 I = 1,3                                                      00119
C  XT AND VT ARE THE POSITION AND VELOCITY VECTORS AFTER APOGEE BURN    00120
      XT(I) = XTR(I)-GMU*XTR(I)*(DT**2)/(2.D0*RMAG**3)+VTR(I)*DT+TV(I)* 00121
     1  ((W+DW+WC*DT)/(WC**2)*TEMP-DT/WC)                               00122
      VT(I) = -GMU*XTR(I)*DT/(RMAG**3)+VTR(I)+TV(I)/WC*TEMP             00123
    2 CONTINUE                                                          00124
      RETURN                                                            00125
      END                                                               00126
C          DATA SET CONBR      AT LEVEL 003 AS OF 06/22/79
C          DATA SET CONBR      AT LEVEL 002 AS OF 05/30/79              00001
C          DATA SET CONBR      AT LEVEL 001 AS OF 04/04/78              00002
      SUBROUTINE CONBR(XI,XO,KEY)                                       00003
C                                                                       00004
C                                                                       00005
C  SUBROUTINE CONBR(XI,XO,KEY)                                          00006
C                                                                       00007
C  THE PURPOSE OF CONBR IS TO FIND THE CONIC SECTION BETWEEN TWO        00008
C  RADIUS VECTORS SUCH THAT THE TRANSFER TIME IS CONSTRAINED TO A       00009
C  GIVEN VALUE.                                                         00010
C                                                                       00011
C  ARGUMENTS IN THE CALLING SEQUENCE ARE DEFINED AS FOLLOWS:            00012
C                                                                       00013
C  ARGUMENT  TYPE  I/O    DEFINITION                                    00014
C                                                                       00015
C     XI     R*8    I     INPUT ARRAY-SEE DEFINITIONS BELOW             00016
C     XO     R*8    O     OUTPUT ARRAY-SEE DEFINITIONS BELOW            00017
C     KEY    I*4   I/O    A FLAG:  IF KEY IS NOT EQUAL TO 1,            00018
C                                  THE PROPERTIES OF ORBIT AT THE       00019
C                                  INITIAL POINT MUST BE DETEMINED      00020
C                                                                       00021
C                                                                       00022
C  CONBR IS CALLED BY THE FOLLOWING SUBROUTINE:                         00023
C                                                                       00024
C     RANTAR                                                            00025
C                                                                       00026
C  THE FOLLOWING SUBROUTINES ARE CALLED BY RANTAR:                      00027
C                                                                       00028
C     AMUD    FINDV     TCONIC                                          00029
C                                                                       00030
C  THE VARIABLE APPEARING BELOW IN A COMMON BLOCK IS GIVEN BELOW:       00031
C                                                                       00032
C  COMMON VARIABLE USED: XPI                                            00033
C                                                                       00034
C                                                                       00035
      IMPLICIT REAL*8(A-H,O-Z,$)                                        00036
      COMMON /CONST/ S2LB,D2R,XPI,R2D,F2KM,XKM2F,G0                     00037
      DIMENSION     XI(6),         XO(8),         X(6),          XX(6)  00038
C     MODIFIED ITER OF QUICK LOOK PROGRAM                               00039
C     XI(1)=RAD OF STARTING POINT                                       00040
C     XI(2)=RAD OF END POINT                                            00041
C     XI(3)=CENTRAL ANGLE BETWEEN THE POINTS + FOR PROGRADE ORBIT       00042
C     XI(4)=TIME BETWEEN TWO POINTS                                     00043
C     XI(5)=GRAVITATIONAL CONSTANT OF CENTRAL BODY                      00044
C     XI(6)=TIME ERROR IN SOLUTION                                      00045
C     XO(1)=PATH ANGLE                                                  00046
C     XO(2)=VELOCITY                                                    00047
C     XO(3)=SEMI-MAJOR AXIS                                             00048
C     XO(4)=NUMBER OF ITERATIONS                                        00049
C     XO(5)=ANGLE USED                                                  00050
C     XO(6)=NUMBER OF ORBITS BEFORE ENCOUNTER                           00051
C     XO(7)= FLIGHT PATH ANGLE ' TARGET                                 00052
C     XO(8)=ARRIVAL VELOCITY, TARGET                                    00053
      DIMENSION     FX(6),         IC(6),         Y(8)                  00054
      EQUIVALENCE ( X(1), R1 ),( X(2), R2  ),( X(3), SIP )              00055
     1,           ( X(4),  TT),( X(5),  U  ),( X(6), OUT )              00056
     2,           (XX(1), GAM),(FX(1), DT  ),(IC(1) , IK )              00057
     3,           (XX(2),GAML),(FX(2),ERO  ),(IC(2) , NM )              00058
     4,           (XX(3),GLIM),(FX(3),SS   ),(IC(3) ,NSTP)              00059
     5,           ( Y(1),GOUT),( Y(2), V   ),( Y(3), A   )              00060
     6,           ( Y(4),KSTP),( Y(5), PSI ),( Y(6),VNMAX)              00061
     7,           ( Y(7),GAM2),( Y(8), V2  )                            00062
      EQUIVALENCE  (CPSI,ECTH,CPHI,CG)                                  00063
      EQUIVALENCE  (SPSI,ESTH,SPHI,SG)                                  00064
C                                                                       00065
C                                                                       00066
C                                                                       00067
      TPI=XPI*2.D0                                                      00068
      DATA     NM,IC(4) / 20,0 /                                        00069
C                                                                       00070
      NTIME=KEY                                                         00071
      IF(NTIME.EQ.1) GO TO 66                                           00072
      DO 1 I=1,6                                                        00073
      X(I)=XI(I)                                                        00074
1     CONTINUE                                                          00075
      VN=IDINT(SIP/TPI)                                                 00076
C  COMPUTE PSI, THE CENTRAL ANGLE BETWEEN THE RADIUS VECTORS ,PSI < 2*PI00077
      PSI=SIP-VN*TPI                                                    00078
      VN=DABS(VN)                                                       00079
      SGSI=DSIGN(1.0D0,PSI)                                             00080
      PSI=DABS (PSI)                                                    00081
      SPSI=DSIN (PSI)                                                   00082
      CPSI=DCOS (PSI)                                                   00083
      D=2.D0*U/R1                                                       00084
      R12=R1*R1/U                                                       00085
      D1=R2*CPSI-R1                                                     00086
      D2=R2*SPSI                                                        00087
      D3=R1*R2*(1.D0-CPSI)                                              00088
C  CHORD=STRAIGHT LINE DISTANCE FROM THE FIRST BODY TO THE TARGET BODY. 00089
      CHORD=DSQRT(D1*D1+D2*D2)                                          00090
C  FLIGHT PATH ANGLE LIMITS ARE FOR ESCAPE PARABOLA AND FOR ZERO-TIME   00091
      ALPH=DATAN2(D2,D1)                                                00092
      IF(ALPH .LT.0.0D0) ALPH =ALPH +TPI                                00093
      CO=(R1-R2)/CHORD                                                  00094
      SUM =DATAN2(DSQRT(1.D0-CO*CO),CO)                                 00095
      GAML=(SUM-ALPH)/2.D0                                              00096
      GLIM=-((SUM+ALPH)/2.D0)+XPI                                       00097
      NTIME=2                                                           00098
C  A=SEMI-MAJOR AXIS FOR THE MINIMUM TIME ELLIPSE CONNECTING THE TWO    00099
C  POINTS.                                                              00100
      A=(R1+R2+CHORD)/4.D0                                              00101
C  PER=PERIOD FOR THE MINIMUM TIME ELLIPSE                              00102
      PER=TPI*A*DSQRT(A/U)                                              00103
      VNMAX=IDINT(TT/PER)                                               00104
      IF(VN) 2,2,250                                                    00105
250   CONTINUE                                                          00106
      NTIME=1                                                           00107
C  COMPUTING THE MINIMUM-PERIOD ELLIPSE CONNECTING R1 AND R2 BY PSI     00108
      TAT=2.D0*A                                                        00109
      P=2.D0*(TAT-R1)*(TAT-R2)/CHORD                                    00110
C  COMPUTE THE ECCENTRICITY OF THE MINIMUM TIME ELLIPSE                 00111
      E=DSQRT(1.D0-P/A)                                                 00112
      CPHI=(P/R1-1.D0)/E                                                00113
      SPHI=DSQRT(1.D0-CPHI*CPHI)                                        00114
C  COMPUTE THE TRUE ANOMALY                                             00115
      PHI =DATAN2(SPHI,CPHI)                                            00116
      TAT=PHI+PSI                                                       00117
      R2C=1.D0+E*DCOS(TAT)                                              00118
      R2C=P/R2C                                                         00119
      R2C=DABS(R2C/R2-1.D0)                                             00120
      IF(R2C.LT..0001D0) GO TO 56                                       00121
      PHI=-PHI                                                          00122
      TAT=PHI+PSI                                                       00123
56    CONTINUE                                                          00124
      C3=-(U/A)                                                         00125
      V2=C3+2.D0*U/R1                                                   00126
C  COMPUTE THE VELOCITY AT R1                                           00127
      V=DSQRT(V2)                                                       00128
      SGAM=DSQRT(U/P)*E*DSIN(PHI)/V                                     00129
      CGAM=DSQRT(1.D0-SGAM*SGAM)                                        00130
      FPA=DATAN(SGAM/CGAM)                                              00131
   55 CALL TCONIC(U,E,A,P,PHI,DELT,FAC)                                 00132
      CALL TCONIC(U,E,A,P,TAT,T,FAC)                                    00133
      DELT=T-DELT                                                       00134
      IF(DELT.LE.0.0D0) DELT=DELT+PER                                   00135
63    CONTINUE                                                          00136
      IF(DELT+VN*PER-TT) 65,65,64                                       00137
64    VN=VN-1.D0                                                        00138
      NTIME=2                                                           00139
      GO TO 63                                                          00140
65    CONTINUE                                                          00141
      GSAV=GAML                                                         00142
      GAML=FPA                                                          00143
      GO TO 3                                                           00144
66    CONTINUE                                                          00145
      PSI=AMUD(PSI,TPI)                                                 00146
      GAM=FPA                                                           00147
      GAML=GSAV                                                         00148
      GLIM=GAM                                                          00149
      SS=.3D0*(GAML-GAM)                                                00150
      NTIME=2                                                           00151
      GO TO 5                                                           00152
2     CONTINUE                                                          00153
      GAML=-XPI/2.D0                                                    00154
      IF(D2.GT.0.0D0) GAML = DATAN(D1/D2)                               00155
3     CONTINUE                                                          00156
      GAM=GAML                                                          00157
      SS=3.D0*(GLIM-GAM)                                                00158
5     CONTINUE                                                          00159
      GAM=GAM+.0001D0*SS                                                00160
    6 CONTINUE                                                          00161
      ERO=OUT*TT                                                        00162
      IK=-1                                                             00163
    7 CONTINUE                                                          00164
      SG=DSIN (GAM)                                                     00165
      CG=DCOS (GAM)                                                     00166
      P=D3/(D2*SG/CG-D1)                                                00167
      V2=P/(R12*CG*CG)                                                  00168
      V=DSQRT (V2)                                                      00169
      C3=V2-D                                                           00170
      A=-U/C3                                                           00171
      E=DSQRT (1.D0-P/A)                                                00172
      CO=DSQRT(P/U)                                                     00173
      ESTH=V*SG*CO                                                      00174
      ECTH=P/R1-1.D0                                                    00175
      PHI =DATAN2(ESTH,ECTH)                                            00176
      N=1                                                               00177
    8 CONTINUE                                                          00178
      CALL TCONIC(U,E,A,P,PHI,T,FAC)                                    00179
    9 GO TO (10,11),N                                                   00180
   10 DELT=T                                                            00181
      PHI=PHI+PSI                                                       00182
      N=2                                                               00183
      GO TO 8                                                           00184
   11 DELT=T-DELT                                                       00185
      PER=TPI*FAC                                                       00186
      IF(C3)12,12,15                                                    00187
   12 IF(DELT.LE.0.0D0) DELT=DELT+PER                                   00188
      DELT=DELT+VN*PER                                                  00189
   15 DT=DELT-TT                                                        00190
      GAMB4=GAM                                                         00191
      CALL FINDV(XX,FX,IC)                                              00192
      IF(IK) 17,7,16                                                    00193
   16 GAM=GAMB4                                                         00194
   17 CONTINUE                                                          00195
C  THE FOLLOWING COMPUTATIONS DEFINE THE FLIGHT PATH ANGLE AT THE       00196
C  TARGET BODY                                                          00197
      V2=C3+2.D0*U/R2                                                   00198
      V2=DSQRT(V2)                                                      00199
      SG=E*DSIN(PHI)/V2                                                 00200
      SG=SG/CO                                                          00201
      CG=DSQRT(1.D0-SG*SG)                                              00202
C  COMPUTE GAM2, THE FLIGHT PATH ANGLE AT THE TARGET BODY.              00203
      GAM2=DATAN2(SG,CG)                                                00204
      IF(C3.LT.0.0D0) PSI=(PSI+VN*TPI)*SGSI                             00205
      GOUT=GAM                                                          00206
      KSTP=NSTP                                                         00207
      DO 24 I=1,8                                                       00208
   24 XO(I)=Y(I)                                                        00209
      KEY=NTIME                                                         00210
      RETURN                                                            00211
      END                                                               00212
C          DATA SET CONVET     AT LEVEL 003 AS OF 06/22/79
C          DATA SET CONVET     AT LEVEL 002 AS OF 06/01/79              00001
C                                                                       00002
      SUBROUTINE CONVET (P,R,V,K,PQ)                                    00003
C                                                                       00004
C                                                                       00005
C     SUBROUTINE CONVET (P,R,V,K,PQ)                                    00006
C                                                                       00007
C                                                                       00008
C                                                                       00009
C     THE PURPOSE OF CONVET IS TO DETERMINE THE TRANSFORMATION MATRIX   00010
C         FROM THE LOCAL TANGENT COORDINATE SYSTEM TO THE EQUATORIAL    00011
C         COORDINATE SYSTEM.                                            00012
C                                                                       00013
C                                                                       00014
C                                                                       00015
C     ARGUMENTS IN THE CALLING SEQUENCE ARE DEFINED AS FOLLOWS.         00016
C                                                                       00017
C         ARGUMENT   TYPE    I/O        DEFINITION                      00018
C                                                                       00019
C          P(6,6)    R*8      I      COVARIANCE MATRIX TO BE            00020
C                                         TRANSFORMED                   00021
C          R(3)      R*8      I      RADIUS VECTOR                      00022
C          V(3)      R*8      I      VELOCITY VECTOR                    00023
C          K         I*4      I      K=0, P TRANSFORMED FROM EQUATORIAL 00024
C                                         TO LOCAL TANGENT SYSTEM       00025
C                                    K=1, NO TRANSFORMATION             00026
C                                    K=2, P TRANSFORMATION FROM LOCAL   00027
C                                         TANGENT TO EQUATORIAL SYSTEM  00028
C          PQ(6,6)   R*8      O      TRANSFORMED COVARIANCE MATRIX      00029
C                                                                       00030
C                                                                       00031
C                                                                       00032
C     CONVET IS CALLED BY THE FOLLOWING SUBROUTINES.                    00033
C                                                                       00034
C       CVPROP    GEOS    GEOSY    GUIDE   MTXPR   SCAN                 00035
C                                                                       00036
C     THE FOLLOWING SUBROUTINES ARE CALLED BY CONVET.                   00037
C                                                                       00038
C         CROSS     MTRX                                                00039
C                                                                       00040
C                                                                       00041
C                                                                       00042
C     THE FOLLOWING FUNCTION SUBPROGRAM IS CALLED BY CONVET.            00043
C                                                                       00044
C         FNORM                                                         00045
C                                                                       00046
C                                                                       00047
C                                                                       00048
C     CONVET NEITHER USES NOR ALTERS VARIABLES IN COMMON. ALL INPUT     00049
C     AND OUTPUT IS THROUGH THE CALLING SEQUENCE.                       00050
C                                                                       00051
C                                                                       00052
C                                                                       00053
C                                                                       00054
C        K=1   NO TRANSFORMATION                                        00055
C        K=2   P TRANSFORMED FROM LOCAL TANGENT TO EQUATOR 50           00056
C        K=0   P TRANSFORMED FROM EQUATOR 50 TO LOCAL TANGENT           00057
C        Q IS THE TRANSFORMATION                                        00058
      IMPLICIT REAL*8(A-H,O-Z)                                          00059
      DOUBLE PRECISION P(6,6), Q(6,6), DUM, PQ(6,6)                     00060
      DIMENSION R(3), V(3), RXV(3), RXVXR(3)                            00061
C  K=1 INDICATES NO TRANSFORMATION IS REQUIRED                          00062
      IF (K .EQ. 1) RETURN                                              00063
C  RXV IS THE ANGULAR MOMENTUM PER UNIT MASS VECTOR                     00064
C  R, RXV, AND RXVXR DEFINE A SPACECRAFT CENTERED COORDINATE SYSTEM.    00065
      CALL CROSS (R,V,RXV)                                              00066
      CALL CROSS (RXV, R, RXVXR)                                        00067
      RN=FNORM(R)+1.D-60                                                00068
      RXVN=FNORM(RXV)+1.D-60                                            00069
      RXVXRN=FNORM(RXVXR)+1.D-60                                        00070
      DO 1 I=1,3                                                        00071
      Q(I,1) = RXVXR(I) /RXVXRN                                         00072
      Q(I,2) = RXV(I) /RXVN                                             00073
      Q(I,3) = R(I) /RN                                                 00074
      DO 2 J=1,3                                                        00075
      Q(I+3 ,J+3) = Q(I,J)                                              00076
      Q(I+3, J) = 0.D0                                                  00077
      Q(I, J+3) = 0.D0                                                  00078
2     CONTINUE                                                          00079
1     CONTINUE                                                          00080
      IF (K .EQ. 2) GO TO 3                                             00081
C  COMPUTE THE TRANSPOSE OF Q, TO FACILITATE THE TRANSFORMATION OF P    00082
C  FROM THE EQUATORIAL TO THE LOCAL TANGENT SYSTEM.                     00083
      DO 4 I=1,6                                                        00084
      DO 5 J=1,I                                                        00085
      DUM = Q(I,J)                                                      00086
      Q(I,J) = Q(J,I)                                                   00087
5     Q(J,I) = DUM                                                      00088
4     CONTINUE                                                          00089
C  COMPUTE PQ= QPQ TRANSPOSE                                            00090
3     CALL MTRX (Q, P, PQ, 6, 6,-1)                                     00091
      RETURN                                                            00092
      END                                                               00093
C          DATA SET COVAR      AT LEVEL 003 AS OF 06/25/79
C          DATA SET COVAR      AT LEVEL 002 AS OF 10/26/78              00001
      SUBROUTINE COVAR(LUTP,ELT,NP,NT,NCOV,MFLAG,EV,E,V,SD,XXM,ANOM)    00002
C                                                                       00003
C                                                                       00004
C     SUBROUTINE COVAR (LUTP,ELT,NP,NT,NCOV,MFLAG,EV,E,V,SD,XXM,ANOM)   00005
C                                                                       00006
C                                                                       00007
C                                                                       00008
C     THE PURPOSE OF COVAR IS TO CALCULATE STANDARD DEVIATIONS,         00009
C         EIGENVECTORS, AND EIGENVALUES FROM AN INITIAL STATE VECTOR AND00010
C         A NOMINAL STATE VECTOR.                                       00011
C                                                                       00012
C                                                                       00013
C                                                                       00014
C     ARGUMENTS IN THE CALLING SEQUENCE ARE DEFINED AS FOLLOWS.         00015
C                                                                       00016
C         ARGUMENT   TYPE    I/O        DEFINITION                      00017
C                                                                       00018
C          LUTP      I*4             NOT USED                           00019
C          ELT(25)   R*8      I      INITIAL STATE VECTOR               00020
C          NP        I*4      I      STATE VECTOR DIMENSION             00021
C          NT        I*4      I      COVARIANCE MATRIX DIMENSION        00022
C          NCOV(6)   I*4      I      COVARIANCE OUTPUT FLAG             00023
C          MFLAG     I*4      I      =0; OUTPUT MEAN COVARIANCE MATRIX  00024
C                                    =1; OUTPUT MEAN COVARIANCE MATRIX  00025
C                                       WITH RESPECT TO NOMINAL         00026
C          EV(NT,NT) R*8      O      EIGENVECTORS                       00027
C          E(6)      R*8      O      EIGENVALUES                        00028
C          V(6,6)    R*8      O      COVARIANCE MATRIX                  00029
C          SD(6)     R*8      O      STANDARD DEVIATIONS                00030
C          XXM(6)    R*8      O      MEAN STATE VECTOR                  00031
C          ANOM(25)  R*8      O      NOMINAL STATE VECTOR               00032
C                                                                       00033
C                                                                       00034
C                                                                       00035
C     COVAR IS CALLED BY THE FOLLOWING SUBROUTINES.                     00036
C                                                                       00037
C         M2STAT                                                        00038
C                                                                       00039
C                                                                       00040
C                                                                       00041
C                                                                       00042
C     THE FOLLOWING SUBROUTINE IS CALLED BY COVAR.                      00043
C                                                                       00044
C         EIGEN                                                         00045
C                                                                       00046
C                                                                       00047
C                                                                       00048
C     THE VARIABLE APPEARING IN COMMON BLOCKS IS TABULATED BELOW.       00049
C                                                                       00050
C         COMMON VARIABLE USED                                          00051
C                                                                       00052
C         LU20                                                          00053
C                                                                       00054
C                                                                       00055
C                                                                       00056
      IMPLICIT REAL*8(A-H,O-Z)                                          00057
      COMMON/LUS/LU8,LU9,LU16,LU20                                      00058
      DIMENSION ANOM(50),XXM(6),ELT(50),NCOV(6),EV(NT,NT)               00059
      DIMENSION E(6),V(6,6),SD(6),XM(6),CV(6,6),VM(6,6)                 00060
      DIMENSION SE(6)                                                   00061
      REAL*8 ZB(50)                                                     00062
      REWIND LU20                                                       00063
C  *** BEGIN INITIALIZATION OF VARIABLES ***                            00064
      DO 10 I=1,6                                                       00065
      XXM(I)=0.D0                                                       00066
      XM(I)=0.D0                                                        00067
      E(I)=0.D0                                                         00068
      SD(I)=0.D0                                                        00069
      SE(I)=0.D0                                                        00070
      DO 20 J=1,6                                                       00071
      V(I,J)=0.D0                                                       00072
      VM(I,J)=0.D0                                                      00073
      CV(I,J)=0.D0                                                      00074
   20 CONTINUE                                                          00075
   10 CONTINUE                                                          00076
      DO 30 I=1,NT                                                      00077
      DO 40 J=1,NT                                                      00078
      EV(I,J)=0.D0                                                      00079
   40 CONTINUE                                                          00080
   30 CONTINUE                                                          00081
C  *** END INITIALIZATION OF VARIABLES ***                              00082
      READ(LU20)ELT                                                     00083
      READ(LU20)ANOM                                                    00084
      DO 400 J1=1,NP                                                    00085
      READ(LU20)ZB                                                      00086
      ENP=NP                                                            00087
      DO 300 I=1,NT                                                     00088
      L=NCOV(I)                                                         00089
      XM(I)=XM(I)+ZB(L)                                                 00090
      XXM(I)=XXM(I)+ZB(L)+ANOM(L)                                       00091
      DO 200 II=1,NT                                                    00092
      V(I,II)=V(I,II)+ZB(NCOV(I))*ZB(NCOV(II))                          00093
      VM(I,II)=VM(I,II)+(ZB(NCOV(I))+ANOM(NCOV(I)))*                    00094
     1 (ZB(NCOV(II))+ANOM(NCOV(II)))                                    00095
  200 CONTINUE                                                          00096
  300 CONTINUE                                                          00097
  400 CONTINUE                                                          00098
      DO 600 I=1,NT                                                     00099
      DO 500 J=I,NT                                                     00100
C  COMPUTE OUTPUT MEAN COVARIANCE MATRIX                                00101
      IF(MFLAG.EQ.0)  V(I,J)=(VM(I,J)-XXM(I)*XXM(J)/ENP)/(ENP-1.D0)     00102
C  COMPUTE OUTPUT MEAN COVARIANCE MATRIX WRT NOMINAL                    00103
      IF(MFLAG.EQ.1)V(I,J)=(V(I,J)-XM(I)*XM(J)/ENP)/(ENP-1.D0)          00104
      V(J,I)=V(I,J)                                                     00105
      EV(I,J)=V(I,J)                                                    00106
      EV(J,I)=EV(I,J)                                                   00107
  500 CONTINUE                                                          00108
      XM(I)=XM(I)/ENP                                                   00109
      XXM(I)=XXM(I)/ENP                                                 00110
  600 CONTINUE                                                          00111
C  COMPUTE THE EIGENVECTORS (EV) AND EIGENVALUES (E) CORRESPONDING TO   00112
C  THE INPUT REAL SYMMETRIC MATRIX (EV).                                00113
      CALL EIGEN(EV,E,NT,1)                                             00114
C  COMPUTE STANDARD DEVIATIONS (SD) AND SQUARE ROOTS EIGENVALUES (SE).  00115
      DO 700 I=1,NT                                                     00116
      SD(I)=DSQRT(V(I,I))                                               00117
      SE(I) = DSQRT (DMAX1(E(I),0.D0))                                  00118
  700 CONTINUE                                                          00119
      DO 900 I=1,NT                                                     00120
      DO 800 J=1,NT                                                     00121
      IF(SD(I)*SD(J).EQ.0.D0) GO TO 800                                 00122
      CV(I,J)=V(I,J)/(SD(I)*SD(J))                                      00123
  800 CONTINUE                                                          00124
  900 CONTINUE                                                          00125
      REWIND LU20                                                       00126
      WRITE(6,960)(ELT(NCOV(I)),I=1,NT)                                 00127
  901 WRITE(6,910) (ANOM(NCOV(I)),I=1,NT)                               00128
      WRITE(6,912) (XXM(I),I=1,6)                                       00129
      WRITE(6,915) (XM(I),I=1,6)                                        00130
      IF(MFLAG.EQ.1) GO TO 903                                          00131
  902 WRITE(6,925) ((V(I,J),J=1,6),I=1,6)                               00132
      GO TO 904                                                         00133
  903 WRITE(6,920) ((V(I,J),J=1,6),I=1,6)                               00134
  904 WRITE(6,930) (E(I),I=1,6)                                         00135
      WRITE (6,935) SE                                                  00136
      WRITE(6,940) (SD(I),I=1,6)                                        00137
      WRITE(6,950) ((CV(I,J),J=1,6),I=1,6)                              00138
  910 FORMAT(/5X,22HSTATE VECTOR (NOMINAL)/(6D21.13))                   00139
  912 FORMAT(/5X,11HMEAN VECTOR/(6D21.13))                              00140
  915 FORMAT(/5X,25HMEAN VECTOR (WRT NOMINAL)/(6D21.13))                00141
  920 FORMAT(/5X,36HCOVARIANCE MATRIX - MEAN WRT NOMINAL /(6D21.13))    00142
  925 FORMAT(/5X,24HCOVARIANCE MATRIX - MEAN /(6D21.13))                00143
  930 FORMAT(5X,11HEIGENVALUES/(6D21.13))                               00144
  935 FORMAT (/5X,'SQUARE ROOTS OF EIGENVALUES'/(6D21.13))              00145
  940 FORMAT(5X,19HSTANDARD DEVIATIONS /(6D21.13))                      00146
  950 FORMAT(/5X,18HCORRELATION MATRIX /(6D21.13))                      00147
  960 FORMAT(/,7X,6(7X,A8,6X))                                          00148
      RETURN                                                            00149
      END                                                               00150
C          DATA SET COVIN      AT LEVEL 003 AS OF 06/25/79
C          DATA SET COVIN      AT LEVEL 002 AS OF 05/22/78              00001
      SUBROUTINE COVIN(P1II,P2II,P3II,P4II,P5II,P6II)                   00002
C                                                                       00003
C                                                                       00004
C     SUBROUTINE COVIN (P1II,P2II,P3II,P4II,P5II,P6II)                  00005
C                                                                       00006
C                                                                       00007
C                                                                       00008
C     THE PURPOSE OF COVIN IS TO FILL IN THE ELEMENTS OF A 6 BY 6       00009
C         SYMMETRIC MATRIX USING THE 21 ELEMENTS FROM THE UPPER DIA-    00010
C         GONAL WHICH ARE INPUT.                                        00011
C                                                                       00012
C                                                                       00013
C                                                                       00014
C     ARGUMENTS IN THE CALLING SEQUENCE ARE DEFINED AS FOLLOWS.         00015
C                                                                       00016
C         ARGUMENT   TYPE    I/O        DEFINITION                      00017
C                                                                       00018
C          P1II(21)  R*8      I      UPPER DIAGONAL OF FIRST            00019
C                                        SYMMETRIC MATRIX               00020
C          P2II(21)  R*8      I      UPPER DIAGONAL OF SECOND           00021
C                                        SYMMETRIC MATRIX               00022
C          P3II(21)  R*8      I      UPPER DIAGONAL OF THIRD            00023
C                                        SYMMETRIC MATRIX               00024
C          P4II(21)  R*8      I      UPPER DIAGONAL OF FOURTH           00025
C                                        SYMMETRIC MATRIX               00026
C          P5II(21)  R*8      I      UPPER DIAGONAL OF FIFTH            00027
C                                        SYMMETRIC MATRIX               00028
C          P6II(21)  R*8      I      UPPER DIAGONAL OF SIXTH            00029
C                                        SYMMETRIC MATRIX               00030
C                                                                       00031
C                                                                       00032
C                                                                       00033
C     COVIN IS CALLED BY THE FOLLOWING SUBROUTINES.                     00034
C                                                                       00035
C         MAIN                                                          00036
C                                                                       00037
C                                                                       00038
C     NO SUBROUTINES ARE CALLED COVIN.                                  00039
C                                                                       00040
C                                                                       00041
C                                                                       00042
C     THE VARIABLES APPEARING IN COMMON BLOCKS ARE TABULATED BELOW.     00043
C                                                                       00044
C         COMMON VARIABLES USED                                         00045
C                                                                       00046
C         F2KM      IP2COR    IP4COR    IP6COR                          00047
C         IP1COR    IP3COR    IP5COR                                    00048
C                                                                       00049
C         COMMON VARIABLES USED AND COMPUTED                            00050
C                                                                       00051
C         P1I       P3I       P5I                                       00052
C         P2I       P4I       P6I                                       00053
C                                                                       00054
C                                                                       00055
C                                                                       00056
      IMPLICIT REAL*8(A-H,O-Z)                                          00057
      REAL*8 NAMES                                                      00058
      REAL*4 ZDELT,ZUB                                                  00059
      COMMON /CONST/ S2LB,D2R,XPI,R2D,F2KM,XKM2F,G0                     00060
      COMMON /GENRL/ P1,PI(6,6),XII(6),XMU,NAMES(6),PITCHI,YAWI,WI,     00061
     A P1I(6,6),P2I(6,6),P3I(6,6),P4I(6,6),P5I(6,6),P6I(6,6),TOLR(50),  00062
     * THRUSI,SIGBI(3),ZDELT,ZUB(3,50),                                 00063
     B IP1COR,IP2COR,IP3COR,IP4COR,IP5COR,IP6COR,                       00064
     1 ICOV(50),IHIST(50),IPCOOR,ITPSTR,NCONF,MODE                      00065
     2 ,IKEY,IFRN                                                       00066
      DIMENSION P1II(21),P2II(21),P3II(21),P4II(21),P5II(21),P6II(21)   00067
C                                                                       00068
C  COMPUTE THE UPPER DIAGONALS OF THE SIX SYMMETRIC MATRICES.           00069
C                                                                       00070
      DO 897 I=1,6                                                      00071
      DO 896 J=I,6                                                      00072
      L=I*(13-I)/2+J-6                                                  00073
      P1I(I,J) = P1II(L)                                                00074
      P2I(I,J) = P2II(L)                                                00075
      P3I(I,J) = P3II(L)                                                00076
      P4I(I,J) = P4II(L)                                                00077
      P5I(I,J) = P5II(L)                                                00078
      P6I(I,J) = P6II(L)                                                00079
      P1I(J,I) = P1I(I,J)                                               00080
      P2I(J,I) = P2I(I,J)                                               00081
      P3I(J,I) = P3I(I,J)                                               00082
      P4I(J,I) = P4I(I,J)                                               00083
      P5I(J,I) = P5I(I,J)                                               00084
      P6I(J,I) = P6I(I,J)                                               00085
  896 CONTINUE                                                          00086
  897 CONTINUE                                                          00087
C                                                                       00088
C  PRINT THE  INPUT COVARIANCE MATRICES, IF THE FLAG VALUE .LE. 2.      00089
C                                                                       00090
      IF(P1II(1)+P1II(7)+P1II(12)+P1II(16)+P1II(19)+P1II(21).EQ.0.D0)   00091
     * GO TO 901                                                        00092
      WRITE(6,640)IP1COR,((P1I(I,J),J=1,6),I=1,6)                       00093
  901 IF(P2II(1)+P2II(7)+P2II(12)+P2II(16)+P2II(19)+P2II(21).EQ.0.D0)   00094
     * GO TO 902                                                        00095
      WRITE(6,641)IP2COR,((P2I(I,J),J=1,6),I=1,6)                       00096
  902 IF(P3II(1)+P3II(7)+P3II(12)+P3II(16)+P3II(19)+P3II(21).EQ.0.D0)   00097
     * GO TO 903                                                        00098
      WRITE(6,642)IP3COR,((P3I(I,J),J=1,6),I=1,6)                       00099
  903 IF(P4II(1)+P4II(7)+P4II(12)+P4II(16)+P4II(19)+P4II(21).EQ.0.D0)   00100
     * GO TO 904                                                        00101
      WRITE(6,643)IP4COR,((P4I(I,J),J=1,6),I=1,6)                       00102
  904 IF(P5II(1)+P5II(7)+P5II(12)+P5II(16)+P5II(19)+P5II(21).EQ.0.D0)   00103
     * GO TO 905                                                        00104
      WRITE(6,644)IP5COR,((P5I(I,J),J=1,6),I=1,6)                       00105
  905 IF(P6II(1)+P6II(7)+P6II(12)+P6II(16)+P6II(19)+P6II(21).EQ.0.D0)   00106
     * GO TO 906                                                        00107
      WRITE(6,645)IP6COR,((P6I(I,J),J=1,6),I=1,6)                       00108
  906 CONTINUE                                                          00109
  640 FORMAT(/5X,25HINPUT 1 COVARIANCE MATRIX,5X,9H IP1COR =            00110
     *,I2/(6D21.13))                                                    00111
  641 FORMAT(/5X,25HINPUT 2 COVARIANCE MATRIX,5X,9H IP2COR =            00112
     *,I2/(6D21.13))                                                    00113
  642 FORMAT(/5X,25HINPUT 3 COVARIANCE MATRIX,5X,9H IP3COR =            00114
     *,I2/(6D21.13))                                                    00115
  643 FORMAT(/5X,25HINPUT 4 COVARIANCE MATRIX,5X,9H IP4COR =            00116
     *,I2/(6D21.13))                                                    00117
  644 FORMAT(/5X,25HINPUT 5 COVARIANCE MATRIX,5X,9H IP5COR =            00118
     *,I2/(6D21.13))                                                    00119
  645 FORMAT(/5X,25HINPUT 6 COVARIANCE MATRIX,5X,9H IP6COR =            00120
     *,I2/(6D21.13))                                                    00121
C                                                                       00122
C  CONVERT FROM METRIC TO ENGLISH UNITS IF THE FLAG VALUE .LE. 2        00123
C                                                                       00124
      DO 899 I=1,6                                                      00125
      DO 898 J=1,6                                                      00126
      IF(IP1COR.LE.2)P1I(I,J)=P1I(I,J)*F2KM**2                          00127
      IF(IP2COR.LE.2)P2I(I,J)=P2I(I,J)*F2KM**2                          00128
      IF(IP3COR.LE.2)P3I(I,J)=P3I(I,J)*F2KM**2                          00129
      IF(IP4COR.LE.2)P4I(I,J)=P4I(I,J)*F2KM**2                          00130
      IF(IP5COR.LE.2)P5I(I,J)=P5I(I,J)*F2KM**2                          00131
      IF(IP6COR.LE.2)P6I(I,J)=P6I(I,J)*F2KM**2                          00132
  898 CONTINUE                                                          00133
  899 CONTINUE                                                          00134
      RETURN                                                            00135
      END                                                               00136
C          DATA SET CROSS      AT LEVEL 002 AS OF 06/01/79
C                                                                       00001
      SUBROUTINE CROSS(A,B,C)                                           00002
C                                                                       00003
C                                                                       00004
C     SUBROUTINE CROSS (A,B,C)                                          00005
C                                                                       00006
C                                                                       00007
C                                                                       00008
C     THE PURPOSE OF CROSS IS TO PERFORM THE CROSS PRODUCT OF TWO       00009
C         VECTORS.                                                      00010
C                                                                       00011
C                                                                       00012
C                                                                       00013
C     ARGUMENTS IN THE CALLING SEQUENCE ARE DEFINED AS FOLLOWS.         00014
C                                                                       00015
C         ARGUMENT   TYPE    I/O        DEFINITION                      00016
C                                                                       00017
C          A         R*8      I      FIRST VECTOR (3X1)                 00018
C          B         R*8      I      SECOND VECTOR (3X1)                00019
C          C         R*8      O      RESULTANT VECTOR (3X1)             00020
C                                                                       00021
C                                                                       00022
C                                                                       00023
C     CROSS IS CALLED BY THE FOLLOWING SUBROUTINES.                     00024
C                                                                       00025
C      BURNST   CONVET    DELVS   MINDVH  MODE2  ORB   PARTAL           00026
C         PREP  RANTAR  STEPD  TFY                                      00027
C                                                                       00028
C                                                                       00029
C                                                                       00030
C                                                                       00031
C     NO SUBROUTINES ARE CALLED BY CROSS.                               00032
C                                                                       00033
C                                                                       00034
C                                                                       00035
C     CROSS NEITHER USES NOR ALTERS VARIABLES IN COMMON. ALL INPUT AND  00036
C         OUTPUT IS THROUGH THE CALLING SEQUENCE.                       00037
C                                                                       00038
C                                                                       00039
C                                                                       00040
C                                                                       00041
      IMPLICIT REAL*8(A-H,O-Z)                                          00042
      DIMENSION A(3),B(3),C(3)                                          00043
C     DIMENSION A(3),B(3),C(3)                                          00044
      C(1)=A(2)*B(3)-A(3)*B(2)                                          00045
      C(2)=A(3)*B(1)-A(1)*B(3)                                          00046
      C(3)=A(1)*B(2)-A(2)*B(1)                                          00047
      RETURN                                                            00048
      END                                                               00049
C          DATA SET CVPROP     AT LEVEL 004 AS OF 06/27/79
C          DATA SET CVPROP     AT LEVEL 003 AS OF 05/18/79              00001
      SUBROUTINE CVPROP(PII,IOP,A,K,ELT)                                00002
C                                                                       00003
C                                                                       00004
C     SUBROUTINE CVPROP (P11,10P,A,K,ELT)                               00005
C                                                                       00006
C                                                                       00007
C                                                                       00008
C     THE PURPOSE OF CVPROP IS TO PROPAGATE THE STATE COVARIANCE MATRIX 00009
C         USING STATE TRANSITION MATRICES FOR COASTING AND THRUSTING    00010
C         PHASES OF THE TRAJECTORY.                                     00011
C                                                                       00012
C                                                                       00013
C                                                                       00014
C     ARGUMENTS IN THE CALLING SEQUENCE ARE DEFINED AS FOLLOWS.         00015
C                                                                       00016
C         ARGUMENT   TYPE    I/O        DEFINITION                      00017
C                                                                       00018
C          PII(21)   R*8      O      UPPER HALF OF PROPAGATED STATE     00019
C                                       COVARIANCE MATRIX               00020
C          IOP       I*4      O      OPTION FLAG SET TO 1, IF P11 IS    00021
C                                       OUTPUT                          00022
C          A(50)     R*8      O      ARRAY CONTAINING TRAJECTORY        00023
C                                       PARAMETERS (A(1)THROUGH A(6) ARE00024
C                                       THE ORBITAL ELEMENTS)           00025
C          K         I*4      I      K=0, COVARIANCE MATRIX IS          00026
C                                       PROPAGATED                      00027
C                                    K .NE. 0, ONLY THE STATE VECTOR IS 00028
C                                       PROPAGATED AFTER BEING NOISED   00029
C          ELT(25)   R*8      O      ARRAY CONTAINING LABELS FOR A ARRAY00030
C                                       OUTPUT                          00031
C                                                                       00032
C                                                                       00033
C                                                                       00034
C     CVPROP IS CALLED BY THE FOLLOWING SUBROUTINES.                    00035
C                                                                       00036
C         MAIN                                                          00037
C                                                                       00038
C                                                                       00039
C                                                                       00040
C                                                                       00041
C     THE FOLLOWING SUBROUTINES ARE CALLED BY CVPROP.                   00042
C                                                                       00043
C         BURNST    MTRPLY    MTXPR     POWERX    RANDOM    TWOBDY      00044
C         CONVET    MTRX      PARTAL                                    00045
C                                                                       00046
C                                                                       00047
C                                                                       00048
C     THE FOLLOWING FUNCTION SUBROUTINES ARE CALLED BY CVPROP.          00049
C                                                                       00050
C         ARKTNS    FNORM    DOT     ORB                                00051
C                                                                       00052
C                                                                       00053
C                                                                       00054
C     THE VARIABLES APPEARING IN COMMON BLOCKS ARE TABULATED BELOW.     00055
C                                                                       00056
C         COMMON VARIABLES USED                                         00057
C                                                                       00058
C         DEC       ICVOUT    NBURN     RA        THR1      WWC1        00059
C         DTB1      IFRN      PITCH1    SIGB1     THRUS1    YAW1        00060
C         DTC1      IKEY      P1        S2LB      WC1       XMU         00061
C         D2R       NAMES                                               00062
C                                                                       00063
C         COMMON VARIABLES USED AND COMPUTED                            00064
C                                                                       00065
C         IP1COR    P1I       W1        X11                             00066
C                                                                       00067
C                                                                       00068
C                                                                       00069
      IMPLICIT REAL*8(A-H,O-Y)                                          00070
      REAL*8 NAMES                                                      00071
      COMMON /CONST/ S2LB,D2R,XPI,R2D,F2KM,XKM2F,G0                     00072
      COMMON /GENRL/ P1,PI(6,6),XII(6),XMU,NAMES(6),PITCHI,YAWI,WI,     00073
     A P1I(6,6),P2I(6,6),P3I(6,6),P4I(6,6),P5I(6,6),P6I(6,6),TOLR(25),  00074
     * THRUSI,SIGBI(3),ZDELT,ZUB(3,25),                                 00075
     B IP1COR,IP2COR,IP3COR,IP4COR,IP5COR,IP6COR,                       00076
     1 ICOV(25),IHIST(25),IPCOOR,ITPSTR,NCONF,MODE                      00077
     2 ,IKEY,IFRN                                                       00078
      COMMON /CVPR/       DTBI,DTCI,WCI,RA,DEC,THRI(100),WWCI(100),     00079
     * NBURN,ICVOUT                                                     00080
      DIMENSION XI(6),XC(6),XB(6),V(6,6),H(6,6),THR(100),WWC(100),      00081
     1  C2(30),C3(6),P(6,6),C1(6,6),C4(6),C5(6),E(6),EV(6,6),           00082
     2  B(3,3),AA2(6,3),XX1(3),XX2(3),AA1(6,3),TV(3),Q(6,6),R(6,6),     00083
     3 PAR(3,3),T50(6,3),U(6,6),PII(21),A(50),SIGB(3)                   00084
      DIMENSION ELT(25),CVELT(25),DUM(3)                                00085
      IF(K.NE.0) GO TO 100                                              00086
      WRITE(6,400)ICVOUT,DTCI,DTBI,WI,WCI,(SIGBI(J),J=1,3),             00087
     1THRUSI,PITCHI,YAWI,RA,DEC,NBURN                                   00088
      WRITE(6,401) (THRI(I),I=1,NBURN)                                  00089
      WRITE(6,402) (WWCI(L),L=1,NBURN)                                  00090
  400 FORMAT(1H0,37X,'COVARIANCE PROPAGATION INPUTS',/,45X,             00091
     *'ICVOUT =',I5,/,9X,'DTCI     =',D20.12,2X,'DTBI     =',           00092
     *D20.12,2X,'WI       =',D20.12,2X,'WCI =',D20.12,/,9X,             00093
     *'SIGBI(1) =',D20.12,2X,'SIGBI(2) =',D20.12,2X,                    00094
     *'SIGBI(3) =',D20.12,/,9X,'THRUSI   =',D20.12,2X,                  00095
     *'PITCHI   =',D20.12,2X,'YAWI     =',D20.12,/,41X,                 00096
     *'RA       =',D20.12,2X,'DEC      =',D20.12,/,9X,                  00097
     *'NBURN    =',I5)                                                  00098
  401 FORMAT(1H0,8X,'THRI     =',(5D20.12,/,9X))                        00099
  402 FORMAT(1H0,8X,'WWCI     =',(5D20.12,/,9X))                        00100
      DATA CVELT/3HECC,3HSMA,3HINC,5HOMEGA,4HARGP,5HTHETA,              00101
     1 4HAPOG,3HPER,4HRMAG,4HVMAG,4HRDOT,6HPERIOD,13*8H         /       00102
C                                                                       00103
      DO 15 I=1,25                                                      00104
   15 ELT(I)=CVELT(I)                                                   00105
C  FACTOR IS THE CONVERSION FROM LBS. TO KG./ACCEL DUE TO G IN KM/S/S   00106
      FACTOR = .0044482217D0/.00980665D0                                00107
      DTC = DTCI                                                        00108
      DTB = DTBI                                                        00109
      W   = WI                                                          00110
      WC  = WCI                                                         00111
      PITCH = PITCHI                                                    00112
      YAW = YAWI                                                        00113
      THRUST = THRUSI                                                   00114
C  SIGBI ARRAY CONTAINS THE THRUST, PITCH, AND YAW ERRORS               00115
      SIGB(1) = SIGBI(1)                                                00116
      SIGB(2) = SIGBI(2)                                                00117
      SIGB(3) = SIGBI(3)                                                00118
      DO 10 I= 1,6                                                      00119
      XI(I) = XII(I)                                                    00120
      XC(I) = XI(I)                                                     00121
      XB(I) = XI(I)                                                     00122
      DO 9 J= 1,6                                                       00123
      V(I,J) = 0.D0                                                     00124
      H(I,J) = 0.D0                                                     00125
    9 CONTINUE                                                          00126
      H(I,I)=1.D0                                                       00127
   10 CONTINUE                                                          00128
      ENBURN  = NBURN                                                   00129
      TOTIM = 0.D0                                                      00130
      WCT =0.D0                                                         00131
      DO 104 I = 1,NBURN                                                00132
      THR(I) =THRI(I)                                                   00133
      WWC(I) = WWCI(I)                                                  00134
      IF(THRUST.NE.-1.D0) THR(I)=THRUST                                 00135
      TOTIM = TOTIM + THR(I) * DTB/ENBURN                               00136
      WCT = WCT +WWC(I)                                                 00137
  104 CONTINUE                                                          00138
      IF(WC.NE.1.D0) WCT =WC                                            00139
      IF(WCT.EQ.0.D0) GO TO 61                                          00140
      AISP = -TOTIM / WCT                                               00141
      IF (WC.EQ.1.D0) GO TO 61                                          00142
C  COMPUTE THE DELTA-WEIGHT INTERVAL TABLE                              00143
      DO 60 I= 1,NBURN                                                  00144
      WWC(I) = -THR(I) * DTB/ENBURN/AISP                                00145
   60 CONTINUE                                                          00146
   61 CONTINUE                                                          00147
      DTB = DTB/ENBURN                                                  00148
      WC  = WC /ENBURN                                                  00149
C  COMPUTE P1I, THE COVARIANCE MATRIX TRANSFORMED FROM LOCAL TANGENT    00150
C  TO EQUATORIAL SYSTEM                                                 00151
      IF(IP1COR.EQ.1.OR.IP1COR.EQ.3) CALL CONVET(P1I,XI,XI(4),2,P1I)    00152
      WRITE(6,650)                                                      00153
  650 FORMAT(//,25X,'BEFORE COAST',//)                                  00154
      CALL MTXPR(XI,P1I,E,EV,XMU)                                       00155
      PSI = 0.D0                                                        00156
      IF(DTC.EQ.0.D0) GO TO 551                                         00157
C  SOLVE THE GENERAL TWO BODY PROBLEM: TWOBDY GIVES THE ECCENTRIC       00158
C  ANOMALY (PSI) AND STATE VECTOR (XC) AT SOLUTION TIME, THE NECESSARY  00159
C  PARTIAL DERIVATIVES (P,C1-C3), THE ACCELERATION VECTORS (C4 & C5), & 00160
C  THE RADIUS MAGNITUDES (C6 & C7) AT THE END AND BEGINNING OF THE      00161
C  TIME INTERVAL                                                        00162
      CALL TWOBDY(XI,DTC,XMU,PSI,XC,P,C1,C2,C3,C4,C5,C6,C7)             00163
      DO 711 I= 1,6                                                     00164
      XB(I) = XC(I)                                                     00165
  711 CONTINUE                                                          00166
      WRITE (6,655) ((P(I,J),J=1,6),I=1,6)                              00167
      CALL MTRX(P,P1I,P,6,6,-1)                                         00168
      WRITE (6,660)                                                     00169
      CALL MTXPR(XC,P,E,EV,XMU)                                         00170
C                                                                       00171
  551 IF (DTB.EQ.0.D0) GO TO 552                                        00172
      DO 886 J=1,6                                                      00173
      C2(J) =XC(J)                                                      00174
  886 CONTINUE                                                          00175
      SIGB(1)=(SIGB(1)*S2LB)**2                                         00176
      SIGB(2)=(SIGB(2)*D2R)**2                                          00177
      SIGB(3)=(SIGB(3)*D2R)**2                                          00178
      DO 30 I=1,3                                                       00179
      DO 20 J=1,3                                                       00180
      B(I,J) =0.D0                                                      00181
   20 CONTINUE                                                          00182
      B(I,I) = SIGB(I)                                                  00183
   30 CONTINUE                                                          00184
      IF(DEC*RA.EQ.0.D0) GO TO 203                                      00185
C  TFY FORMS A NEW COORDINATE SYSTEM SPECIFIED BY THREE MUTUALLY        00186
C  PERPENDICULAR UNIT VECTORS.  THE VECTOR DEFINED BY THE SECOND        00187
C  ARGUMENT, IN THIS CASE C2(4)-C2(6), DEFINES THE X DIRECTION          00188
      CALL TFY(C2,C2(4),AA2)                                            00189
      CODEC=DCOS(DEC*D2R)                                               00190
      SIDEC=DSIN(DEC*D2R)                                               00191
      CORA=DCOS(RA*D2R)                                                 00192
      SIRA=DSIN(RA*D2R)                                                 00193
C  XX1 CONTAINS THE SPACECRAFT ATTITUDE IN THE CELESTIAL COORDINATE     00194
C  SYSTEM                                                               00195
      XX1(1) = CODEC * CORA                                             00196
      XX1(2) = CODEC * SIRA                                             00197
      XX1(3) = SIDEC                                                    00198
      DO 206 J=1,3                                                      00199
      XX2(J) =0.D0                                                      00200
      DO 205 KK=1,3                                                     00201
      XX2(J)=XX2(J)+AA2(KK,J)*XX1(KK)                                   00202
  205 CONTINUE                                                          00203
  206 CONTINUE                                                          00204
      PITCH = ARKTNS(180,XX2(1),-XX2(2))                                00205
      YAW=ARKTNS(180,XX2(1)/DCOS(PITCH),XX2(3))/D2R                     00206
      PITCH=PITCH/D2R                                                   00207
  203 WRITE(6,780) PITCH,YAW                                            00208
      CALL TFY (C2,C2(4),AA1)                                           00209
      COYAW=DCOS(YAW*D2R)                                               00210
      SIYAW=DSIN(YAW*D2R)                                               00211
      COPIT=DCOS(PITCH*D2R)                                             00212
      SIPIT=DSIN(PITCH*D2R)                                             00213
C  XX2 CONTAINS THE SPACECRAFT ATTITUDE IN THE ROLL, PITCH, YAW SYSTEM  00214
      XX2(1) = COYAW * COPIT                                            00215
      XX2(2) = -COYAW * SIPIT                                           00216
      XX2(3) = SIYAW                                                    00217
      CALL MTRPLY(AA1,XX2,XX1,3,3,1,6,3,3)                              00218
      DO 888 I= 1,NBURN                                                 00219
C  COMPUTE THE INERTIAL POSITION AND VELOCITY VECTORS AFTER AKM BURN    00220
C  (XB ARRAY) AND THE INERTIAL THRUST VECTOR (TV)                       00221
      CALL BURNST (C2,C2(4),XB,XB(4),W,0.D0,WWC(I),PITCH,TV,DTB,THR(I), 00222
     2 YAW,XMU)                                                         00223
      XMASS = W * FACTOR                                                00224
C  COMPUTE DM/DT, WHERE M IS THE MASS                                   00225
      XMDOT = WWC(I) / DTB * FACTOR                                     00226
C  COMPUTE THE STATE TRANSITION MATRIX, Q,  AT TIME T DURING POWERED    00227
C  FLIGHT AND THE FORWARD PROPAGATION MATRIX, R.                        00228
      CALL POWERX(C2,C2(4),TV,XMASS,XMDOT,0.D0,XMU,DTB,Q,R)             00229
      CALL MTRX (Q,H,H,6,6,0)                                           00230
      CALL MTRX (Q,V,V,6,3,0)                                           00231
      CALL PARTAL(PAR,C2,C2(4),T50,PITCH,YAW,THR(I))                    00232
      CALL MTRPLY (T50,PAR,U,3,3,3,6,3,6)                               00233
      CALL MTRPLY (R,U,T50,6,3,3,6,6,6)                                 00234
      DO 676 J =1,6                                                     00235
      DO 677 L =1,3                                                     00236
      V(J,L) = V(J,L)+ T50(J,L)                                         00237
  677 CONTINUE                                                          00238
  676 CONTINUE                                                          00239
C---------------                                                        00240
C                                                                       00241
C        INSERT BURN CORRECTIONS HERE WHEN THEY'RE READY . ..           00242
      CALL TFY (XB,XB(4),AA2)                                           00243
      DO 106 J= 1,3                                                     00244
      XX2(J) = 0.D0                                                     00245
      DO 105 KK=1,3                                                     00246
      XX2(J)=XX2(J)+AA2(KK,J)*XX1(KK)                                   00247
  105 CONTINUE                                                          00248
  106 CONTINUE                                                          00249
C  COMPUTE THE NEW PITCH AND YAW VALUES                                 00250
      PITCH = ARKTNS(180,XX2(1),-XX2(2))                                00251
      YAW=ARKTNS(180,XX2(1)/DCOS(PITCH),XX2(3))/D2R                     00252
      PITCH=PITCH/D2R                                                   00253
C                                                                       00254
C--------------                                                         00255
      DO 887 J=1,6                                                      00256
      C2(J) = XB(J)                                                     00257
  887 CONTINUE                                                          00258
      W = W + WWC(I)                                                    00259
  888 CONTINUE                                                          00260
      CALL MTRX(H,P,P,6,6,-1)                                           00261
      CALL MTRX(V,B,V,3,3,-1)                                           00262
      WRITE (6,670)                                                     00263
      CALL MTXPR(XB,P,E,EV,XMU)                                         00264
      WRITE (6,680)                                                     00265
      CALL MTXPR(XB,V,E,EV,XMU)                                         00266
      DO 50 I =1,6                                                      00267
      DO 40 J =1,6                                                      00268
      P(I,J) = P(I,J) + V(I,J)                                          00269
   40 CONTINUE                                                          00270
   50 CONTINUE                                                          00271
      WRITE (6,690)                                                     00272
      CALL MTXPR(XB,P,E,EV,XMU)                                         00273
C  CONVERT CARTESIAN TO KEPLERIAN ELEMENTS                              00274
      CALL ORB (XB,XB(4),XMU,C2)                                        00275
      DVBXX=DSQRT((XB(4)-XC(4))**2+(XB(5)-XC(5))**2+                    00276
     1 (XB(6)-XC(6))**2)                                                00277
      WRITE(6,780) PITCH,YAW,DVBXX                                      00278
      WRITE (6,700) (NAMES(I),I=1,6),(C2(I),I=1,6)                      00279
  552 CONTINUE                                                          00280
      CALL ORB(XB,XB(4),XMU,A)                                          00281
      IF(ICVOUT.EQ.0) GO TO 200                                         00282
      WI=W                                                              00283
      DO 120 I=1,6                                                      00284
      XII(I) =XB(I)                                                     00285
      DO 19 J=I,6                                                       00286
      L = I * (13-I)/ 2 + J-6                                           00287
      PII(L)=P(I,J)                                                     00288
      IP1COR=4                                                          00289
      IOP=1                                                             00290
   19 CONTINUE                                                          00291
  120 CONTINUE                                                          00292
      GO TO 200                                                         00293
  100 CALL RANDOM(EV,E,XB,XC,IKEY,IFRN)                                 00294
C  CONVERT CARTESIAN TO KEPLERIAN ELEMENTS                              00295
      CALL ORB (XC,XC(4),XMU,C2)                                        00296
      DO 29 I = 1,6                                                     00297
      A(I) = C2(I)                                                      00298
   29 CONTINUE                                                          00299
  200 CONTINUE                                                          00300
      A(7)=A(2)*(1.D0+A(1))                                             00301
      A(8)=A(2)*(1.D0-A(1))                                             00302
C  COMPUTE RADIUS AND VELOCITY MAGNITUDES, A(9) AND A(10).              00303
      A(9)=FNORM(XC(1))                                                 00304
      A(10)=FNORM(XC(4))                                                00305
      DUM(1)=XC(1)/A(9)                                                 00306
      DUM(2)=XC(2)/A(9)                                                 00307
      DUM(3)=XC(3)/A(9)                                                 00308
      A(11)=DOT(XC(4),DUM)                                              00309
C  A(12) IS THE KEPLERIAN PERIOD.                                       00310
      A(12)=((2.D0*P1)/DSQRT(XMU/A(2)**3))/86400.D0                     00311
      RETURN                                                            00312
  655 FORMAT (/15X,17HTRANSITION MATRIX/(6D21.13))                      00313
  660 FORMAT(//25X,' AFTER COAST '//)                                   00314
  670 FORMAT (//25X,10HAFTER BURN//)                                    00315
  680 FORMAT (//25X,11HBURN ERRORS//)                                   00316
  690 FORMAT (//25X,27HAFTER BURN WITH BURN ERRORS//)                   00317
  691 FORMAT (/13X,'DTC',18X,'DTB',19X,'WC',19X,'DV',16X,'PITCH',18X,   00318
     2 'YAW'/6D21.13)                                                   00319
  700 FORMAT(/5X,'ORBITAL ELEMENTS NOMINAL',/6(13X,A8)/6D21.13)         00320
  780 FORMAT(/13X,'PITCH',15X,'YAW',15X,'DELTAV',/,1X,3D21.13)          00321
C                                                                       00322
      END                                                               00323
C SUBROUTINE DELVS(A,RA,RP,AS,ES,VREOR,AI,AIS,AN,ANS,XMU,DVS,DVN,       00000010
C                   APF,ASM,ESM,VAE,VIN,AMAN)                           00000020
C                                                                       00000030
C DELVS IS A SUBDRIVER WHICH, THROUGH CALLS TO VARIOUS SUBROUTINES      00000040
C DETERMINES THE DELTA-V REQUIRED TO MANEUVER FROM A DRIFT ORBIT        00000050
C TO A FINAL ORBIT.  THE USER MUST SPECIFY THE ORBITAL PARAMETERS       00000060
C OF THE FINAL ORBIT AND THE SEQUENCE OF MANEUVERS USED TO              00000070
C ACHIEVE IT.                                                           00000080
C                                                                       00000090
C ARGUMENTS IN THE CALLING SEQUENCE ARE DEFINED AS FOLLOWS:             00000100
C                                                                       00000110
C  ARGUMENT TYPE I/O DEFINITION(DIMENSION)                              00000120
C                                                                       00000130
C  A        R*8   I  INITIAL SEMIMAJOR AXIS (1)                         00000140
C  RA       R*8   I  INITIAL APOGEE RADIUS (1)                          00000150
C  RP       R*8   I  INITIAL PERIGEE RADIUS (1)                         00000160
C  AS       R*8   I  TARGET SEMIMAJOR AXIS FOR INPLANE MANEUVER (1)     00000170
C  ES       R*8   I  TARGET ECCENTRICITY FOR INPLANE MANEUVER (1)       00000180
C  AI       R*8   I  INITIAL INCLINATION (1)                            00000190
C  AIS      R*8   I  TARGET INCLINATION(1)                              00000200
C  AN       R*8   I  INITIAL RIGHT ASCENSION OF ASCENDING NODE (1)      00000210
C  ANS      R*8   I  TARGET RIGHT ASCENSION OF ASCENDING NODE (1)       00000220
C  XMU      R*8   I  EARTH GRAVITATIONAL CONSTANT (1)                   00000230
C  DVS      R*8   O  ACCUMULATIVE DELTA-V FROM VARIOUS MANEUVERS (1)    00000240
C  DVN      R*8   I  NODE ADJUST FLAG. (.LT.0=DO NOT ADJUST,            00000250
C                                       .GE.0=CHANGE TO ANS)            00000260
C  APF      R*8   I  INITIAL ARGUMENT OF PERIGEE (1)                    00000270
C  ASM      R*8   I  TARGET SEMIMAJOR AXIS FOR COMBINED MANEUVER (1)    00000280
C  ESM      R*8   I  TARGET ECCENTRICITY FOR COMBINED MANEUVER (1)      00000290
C  VAE      R*8   O  DELTA-V FOR INPLANE ADJUSTS (1)                    00000300
C  VIN      R*8   O  DELTA-V FOR OUT-OF-PLANE ADJUSTS (1)               00000310
C  AMAN     R*8   I  FLAGS:  1-MANEUVER 1 TYPE                          00000320
C                            2-MANEUVER 2 TYPE                          00000330
C                            3-FRACTION OF INPLANE CHANGE TO ATTEMPT    00000340
C                              IN COMBINED MANEUVER                     00000350
C                            4-5  NOT CURRENTLY USED                    00000360
C                            6-A MANEUVER FLAG-IF MAN6<0, COMBINED      00000370
C                              MANEUVER AT PERIGEE; IF MAN6>0,COMBINED  00000380
C                              MANEUVER AT APOGEE.                      00000390
C  VREOR    R*8   I  VELOCITY REQUIREMENT PER REOR MANEUVER             00000400
C                                                                       00000410
C DELVS CALLS THE FOLLOWING SUBROUTINES:                                00000420
C                                                                       00000430
C      AP   PA    AEIN                                                  00000440
C                                                                       00000450
C DELVS IS CALLED BY THE FOLLOWING SUBROUTINES:                         00000460
C                                                                       00000470
C      GEOS                                                             00000480
C                                                                       00000490
C  THE VARIABLES APPEARING IN COMMON BLOCKS ARE TABULATED BELOW.        00000500
C                                                                       00000510
C      COMMON VARIABLES USED                                            00000520
C                                                                       00000530
C      R2D  AMAN  AKC                                                   00000540
C                                                                       00000550
C                                                                       00000560
       SUBROUTINE DELVS(A,RA,RP,AS,ES,VREOR,AI,AIS,AN,ANS,XMU,          00000570
     1 DVS,DVN,APF,ASM,ESM,VAE,VIN,AMAN)                                00000580
       IMPLICIT REAL*8 (A-H,O-Z)                                        00000590
C      DEFAULT MANEUVER SEQUENCE IS DEFINED IN BLOCK DATA               00000600
C      INCLUDE COMMON IN BLOCK DATA AND INITIALIZE-ALSO NAMELIST        00000610
C      INPUT.                                                           00000620
      DIMENSION AMAN(6)                                                 00000630
       COMMON/CONST/S2LB,D2R,XPI,R2D,F2KM,XKM2F,GO                      00000640
      COMMON/ELEM/AKC(12)                                               00000650
       COMMON/NOPRNT/NMLIST                                             00000660
      DO 115 I=1,12                                                     00000670
  115 AKC(I)=0.D0                                                       00000680
      RM=0.D0                                                           00000690
      A2=A                                                              00000700
      RP2=RP                                                            00000710
      RA2=RA                                                            00000720
      A1=A                                                              00000730
      RP1=RP                                                            00000740
      RA1=RA                                                            00000750
      MAN1=AMAN(1)                                                      00000760
      MAN2=AMAN(2)                                                      00000770
      AMAN3=AMAN(3)                                                     00000780
      MAN4=AMAN(4)                                                      00000790
      MAN5=AMAN(5)                                                      00000800
      MAN6=AMAN(6)                                                      00000810
C     IMAN IS A MANEUVER COUNTER.                                       00000820
      IMAN=0                                                            00000830
      GO TO(100,200,300,400,500),MAN1                                   00000840
C                                                                       00000850
C  THE NEXT STATEMENTS UP TO BUT NOT INCLUDING STATEMENT NUMBER         00000860
C  200 CAUSE AN APOGEE MANEUVER FOLLOWED BY A PERIGEE MANEUVER          00000870
C  TO BE CALCULATED AND THEN A PERIGEE MANEUVER FOLLOWED BY AN          00000880
C  APOGEE MANEUVER TO BE CALCULATED, SO THAT THE AVERAGE DELTA-V        00000890
C  FOR THE TWO CASES CAN BE DETERMINED.                                 00000900
C                                                                       00000910
  100 CALL AP(AS,ES,A,RA,RP,VAN1,VA,VAN2,VPS,XMU)                       00000920
C     ORBITS, DELTA V'S                                                 00000930
      DVA1=DABS(VAN1-VA)                                                00000940
      DVA2=DABS(VAN2-VPS)                                               00000950
      DXX=DVA1+DVA2                                                     00000960
      A=A1                                                              00000970
      RP=RP1                                                            00000980
      IF(NMLIST.NE.0) WRITE(6,10)AS,ES,A,RA,RP,DVA1,DVA2,DXX            00000990
   10 FORMAT(1X,'RESULT FROM ROUTINE AP',/,                             00001000
     *       1X,'TARGET SEMIMAJOR AXIS =',D16.8,/,                      00001010
     *       1X,'TARGET ECCENTRICITY =',D16.8,/,                        00001020
     *       1X,'INITIAL SEMIMAJOR AXIS =',D16.8,/,                     00001030
     *       1X,'INITIAL RADIUS OF APOGEE =',D16.8,/,                   00001040
     *       1X,'INITIAL RADIUS OF PERIGEE =',D16.8,/,                  00001050
     *       1X,'DELTA-V FOR APOGEE MANEUVER =',D16.8,/,                00001060
     *       1X,'DELTA-V FOR PERIGEE MANEUVER =',D16.8,/,               00001070
     *       1X,'TOTAL DELTA-V FOR A & P MANEUVERS =',D16.8,/)          00001080
      CALL PA(AS,ES,A,RA,RP,VPN1,VP,VPN2,VAS,XMU,MAN1,MAN2)             00001090
C     ORBITS AND DELTA V'S                                              00001100
      DVP1=DABS(VPN1-VP)                                                00001110
      DVP2=DABS(VPN2-VAS)                                               00001120
      DYY=DVP1+DVP2                                                     00001130
      DXY=(DXX+DYY)/2.D0                                                00001140
      IF(NMLIST.NE.0) WRITE(6,20) AS,ES,A,RA,RP,DVP1,DVP2,DYY,DXY       00001150
   20 FORMAT(1X,'RESULT FROM ROUTINE PA',/,                             00001160
     *       1X,'TARGET SEMIMAJOR AXIS =',D16.8,/,                      00001170
     *       1X,'TARGET ECCENTRICITY =',D16.8,/,                        00001180
     *       1X,'INITIAL SEMIMAJOR AXIS =',D16.8,/,                     00001190
     *       1X,'INITIAL RADIUS OF APOGEE =',D16.8,/,                   00001200
     *       1X,'INITIAL RADIUS OF PERIGEE=',D16.8,/,                   00001210
     *       1X,'DELTA-V FOR PERIGEE MANEUVER =',D16.8,/,               00001220
     *       1X,'DELTA-V FOR APOGEE MANEUVER =',D16.8,/,                00001230
     *       1X,'TOTAL DELTA-V FOR P & A MANEUVERS =',D16.8,/,          00001240
     *       1X,'AVERAGE DELTA-V OF AP & PA MANEUVER SERIES =',D16.8,/) 00001250
      VAE=DXY                                                           00001260
      IF(MAN2.EQ.0) DVS=VAE                                             00001270
      IMAN=IMAN+1                                                       00001280
      IF(MAN1.GE.4) DVS=VAE+DVS                                         00001290
      IF(MAN1.GE.4.AND.NMLIST.NE.0)WRITE(6,655) DVS                     00001300
  655 FORMAT(1X,'THE TOTAL DELTA V FOR THE AEIN MANEUVER PLUS THE       00001310
     1  AVERAGE DELTA V FOR THE AP AND PA MANEUVER=',D20.8)             00001320
      IF(IMAN.EQ.2) GO TO 800                                           00001330
      IF(MAN2.EQ.0) GO TO 750                                           00001340
      IF(MAN2.EQ.MAN1) GO TO 760                                        00001350
      GO TO (100,200,300,400,500), MAN2                                 00001360
C                                                                       00001370
C  THE FOLLOWING STATEMENTS UP TO BUT NOT INCLUDING STATEMENT NUMBER    00001380
C  300 CAUSE AN APOGEE MANEUVER FOLLOWED BY A PERIGEE MANEUVER TO       00001390
C  BE SIMULATED.                                                        00001400
C                                                                       00001410
  200 CALL AP(AS,ES,A,RA,RP,VAN1,VA,VAN2,VPS,XMU)                       00001420
      IMAN=IMAN+1                                                       00001430
C     OUTPUT ORBITS AND DELTA V'S                                       00001440
      DVA1=DABS(VAN1-VA)                                                00001450
      DVA2=DABS(VAN2-VPS)                                               00001460
      VAE=DVA1+DVA2                                                     00001470
      IF(MAN2.EQ.0) DVS=VAE                                             00001480
      IF(NMLIST.NE.0) WRITE(6,30)AS,ES,A,RA,RP,DVA1,DVA2,VAE            00001490
   30 FORMAT(1X,'RESULT FROM ROUTINE AP',/,                             00001500
     *       1X,'TARGET SEMIMAJOR AXIS =',D16.8,/,                      00001510
     *       1X,'TARGET ECCENTRICITY =',D16.8,/,                        00001520
     *       1X,'INITIAL SEMIMAJOR AXIS =',D16.8,/,                     00001530
     *       1X,'INITIAL RADIUS OF APOGEE =',D16.8,/,                   00001540
     *       1X,'INITIAL RADIUS OF PERIGEE =',D16.8,/,                  00001550
     *       1X,'DELTA-V FOR APOGEE MANEUVER =',D16.8,/,                00001560
     *       1X,'DELTA-V FOR PERIGEE MANEUVER =',D16.8,/,               00001570
     *       1X,'TOTAL DELTA-V FOR A & P MANEUVERS =',D16.8,/)          00001580
      IF(IMAN.EQ.2) DVS=VAE+DVS                                         00001590
      IF(IMAN.EQ.2.AND.NMLIST.NE.0) WRITE(6,555) DVS                    00001600
  555 FORMAT(1X,'THE TOTAL DELTA VELOCITY FOR BOTH MANEUVERS='          00001610
     1  ,D20.8,/)                                                       00001620
      IF(IMAN.EQ.2) GO TO 800                                           00001630
      IF(MAN2.EQ.0) GO TO 750                                           00001640
      IF(MAN2.EQ.MAN1) GO TO 760                                        00001650
      GO TO (100,200,300,400,500), MAN2                                 00001660
C                                                                       00001670
C  THE FOLLOWING STATEMENTS UP TO BUT NOT INCLUDING STATEMENT NUMBER    00001680
C  400 CAUSE A PERIGEE MANEUVER FOLLOWED BY AN APOGEE MANEUVER TO       00001690
C  BE SIMULATED.                                                        00001700
C                                                                       00001710
  300 CALL PA(AS,ES,A,RA,RP,VPN1,VP,VPN2,VAS,XMU,MAN1,MAN2)             00001720
      IMAN=IMAN+1                                                       00001730
C     OUTPUT ORBITS AND DELTA V'S                                       00001740
      DVP1=DABS(VPN1-VP)                                                00001750
      DVP2=DABS(VPN2-VAS)                                               00001760
      VAE=DVP1+DVP2                                                     00001770
      IF(MAN2.EQ.0) DVS=VAE                                             00001780
      IF(NMLIST.NE.0) WRITE(6,40) AS,ES,A,RA,RP,DVP1,DVP2,VAE           00001790
   40 FORMAT(1X,'RESULT FROM ROUTINE PA',/,                             00001800
     *       1X,'TARGET SEMIMAJOR AXIS =',D16.8,/,                      00001810
     *       1X,'TARGET ECCENTRICITY =',D16.8,/,                        00001820
     *       1X,'INITIAL SEMIMAJOR AXIS =',D16.8,/,                     00001830
     *       1X,'INITIAL RADIUS OF APOGEE =',D16.8,/,                   00001840
     *       1X,'INITIAL RADIUS OF PERIGEE=',D16.8,/,                   00001850
     *       1X,'DELTA-V FOR PERIGEE MANEUVER =',D16.8,/,               00001860
     *       1X,'DELTA-V FOR APOGEE MANEUVER =',D16.8,/,                00001870
     *       1X,'TOTAL DELTA-V FOR P & A MANEUVERS =',D16.8,/)          00001880
      IF(IMAN.EQ.2) DVS=VAE+DVS                                         00001890
      IF(IMAN.EQ.2.AND.NMLIST.NE.0) WRITE(6,555) DVS                    00001900
      IF(IMAN.EQ.2) GO TO 800                                           00001910
      IF(MAN2.EQ.0) GO TO 750                                           00001920
      IF(MAN2.EQ.MAN1) GO TO 760                                        00001930
      GO TO (100,200,300,400,500), MAN2                                 00001940
C                                                                       00001950
C  THE NEXT STATEMENTS UP TO BUT NOT INCLUDING STATEMENT NUMBER         00001960
C  500 CAUSE AN OUT OF PLANE MANEUVER TO BE PERFORMED AT THE LINE       00001970
C  OF RELATIVE NODES NEAREST APOGEE.  NO CHANGE IN A OR E IS            00001980
C  CAUSED BY THIS MANEUVER.                                             00001990
C                                                                       00002000
  400 CALL  AEIN(AS,ES,A,RA,RP,DVN,AIS,AI,AN,ANS,APF,-1.D0,-1.D0,       00002010
     1  DVS,VIN,AMAN3,RM,MAN6,XMU)                                      00002020
      AISD=AIS*R2D                                                      00002030
      AID=AI*R2D                                                        00002040
      AND=AN*R2D                                                        00002050
      ANSD=ANS*R2D                                                      00002060
      APFD=APF*R2D                                                      00002070
      IF(NMLIST.NE.0) WRITE(6,50) AISD,AID,AND,ANSD,APFD,DVS,VIN        00002080
   50 FORMAT(1X,'RESULT FROM AEIN FOR PURE OUT-OF-PLANE MANEUVER',/,    00002090
     *       1X,'TARGET ORBITAL INCLINATION =',D16.8,/,                 00002100
     *       1X,'INITIAL ORBITAL INCLINATION =',D16.8,/,                00002110
     *       1X,'TARGET RIGHT ASCENSION OF ASCENDING NODE =',D16.8,/,   00002120
     *       1X,'INITIAL RIGHT ASCENSION OF ASCENDING NODE =',D16.8,/,  00002130
     *       1X,'INITIAL ARGUMENT OF PERIGEE =',D16.8,/,                00002140
     *       1X,'TOTAL DELTA-V FOR MANEUVER =',D16.8,/,                 00002150
     *       1X,'DELTA-V FOR PLANE CHANGE =',D16.8,/)                   00002160
C                                                                       00002170
C     OUTPUT ORBITS AND DELTA V'S                                       00002180
C     PERFORMS PLANE CHANGE AND NODE CHANGE                             00002190
      IMAN=IMAN+1                                                       00002200
      IF(IMAN.EQ.2) DVS=VAE+VIN                                         00002210
      IF(IMAN.EQ.2.AND.NMLIST.NE.0) WRITE(6,555) DVS                    00002220
      IF(IMAN.EQ.2) GO TO 800                                           00002230
      IF(MAN2.EQ.0) GO TO 750                                           00002240
      IF(MAN2.EQ.MAN1) GO TO 760                                        00002250
      GO TO (100,200,300,400,500), MAN2                                 00002260
C                                                                       00002270
C  THE NEXT STATEMENTS UP TO BUT NOT INCLUDING STATEMENT NUMBER         00002280
C  750 CAUSE A COMBINED MANEUVER TO BE SIMULATED, IN WHICH ALL          00002290
C  OF THE DESIRED NODE AND INCLINATION CHANGE IS ACHIEVED.  IN          00002300
C  ADDITION, PART OR ALL OF THE MAXIMUM ACHIEVABLE CHANGE IN            00002310
C  A CAN BE REALIZED DEPENDING ON THE VALUE OF AMAN3.                   00002320
C                                                                       00002330
  500 CALL AEIN(AS,ES,A,RA,RP,DVN,AIS,AI,AN,ANS,APF,ASM,ESM,            00002340
     1  DVS,VIN,AMAN3,RM,MAN6,XMU)                                      00002350
      AISD=AIS*R2D                                                      00002360
      AID=AI*R2D                                                        00002370
      AND=AN*R2D                                                        00002380
      ANSD=ANS*R2D                                                      00002390
      APFD=APF*R2D                                                      00002400
      IF(NMLIST.NE.0) WRITE(6,60) A,RA,RP,AISD,AID,AND,ANSD,APFD,ASM,ESM00002410
     1 ,DVS,VIN,AMAN3                                                   00002420
   60 FORMAT(1X,'RESULT FROM ROUTINE AEIN FOR COMBINED MANEUVER',/,     00002430
     *       1X,'INTERMEDIATE SEMIMAJOR AXIS =',D16.8,/,                00002440
     *       1X,'INITIAL RADIUS OF APOGEE =',D16.8,/,                   00002450
     *       1X,'INITIAL RADIUS OF PERIGEE =',D16.8,/,                  00002460
     *       1X,'TARGET ORBITAL INCLINATION =',D16.8,/,                 00002470
     *       1X,'INITIAL ORBITAL INCLINATION =',D16.8,/,                00002480
     *       1X,'TARGET RIGHT ASCENSION OF ASCENDING NODE =',D16.8,/,   00002490
     *       1X,'INITIAL RIGHT ASCENSION OF ASCENDING NODE =',D16.8,/,  00002500
     *       1X,'INITAL ARGUMENT OF PERIGEE =',D16.8,/,                 00002510
     *       1X,'TARGET SEMIMAJOR AXIS =',D16.8,/,                      00002520
     *       1X,'TARGET ECCENTRICITY =',D16.8,/,                        00002530
     *       1X,'TOTAL DELTA-V FOR MANEUVER =',D16.8,/,                 00002540
     *       1X,'DELTA-V FOR PLANE CHANGE =',D16.8,/,                   00002550
     *       1X,'PERCENT OF IN-PLANE GOAL ATTEMPTED =',D16.8,/)         00002560
      IMAN=IMAN+1                                                       00002570
      IF (MAN1.EQ.5) A1=AKC(1)                                          00002580
      IF(MAN1.EQ.5.AND.MAN6.LT.0) RA=2.D0*A1-RP                         00002590
      IF(MAN1.EQ.5) RP1=2.D0*A1-RA                                      00002600
      IF(IMAN.EQ.2) DVS=VAE+VIN                                         00002610
      IF(IMAN.EQ.2.AND.NMLIST.NE.0) WRITE(6,555)DVS                     00002620
      IF(IMAN.EQ.2)GO TO 800                                            00002630
      IF(MAN2.EQ.0)GO TO 750                                            00002640
      IF(MAN2.EQ.MAN1) GO TO 760                                        00002650
      GO TO(100,200,300,400,500),MAN2                                   00002660
  750 IF(NMLIST.NE.0) WRITE(6,755)                                      00002670
  755 FORMAT(' ','ONE MANEUVER WAS SPECIFIED')                          00002680
      GOTO 800                                                          00002690
  760 IF(NMLIST.NE.0) WRITE(6,765)                                      00002700
  765 FORMAT(' ','INPUT ERROR, THE SECOND MANEUVER WAS THE SAME AS      00002710
     1  THE FIRST')                                                     00002720
  800 CONTINUE                                                          00002730
C  THE NEXT STATEMENTS DOWN TO AND INCLUDING STATEMENT NUMBER 77        00002740
C  ARE USED TO CALCULATE THE NUMBER OF REORIENTATION MANEUVERS          00002750
C  THAT ARE NECESSARY, AND THE DELTA-V FOR THE REORS.                   00002760
      NREOR=0                                                           00002770
      IF(MAN1.EQ.4.AND.MAN2.EQ.0) GO TO 77                              00002780
      IF(VIN.EQ.0.0) MAN6=0                                             00002790
      RP1=RP2                                                           00002800
      IF(MAN1.EQ.5.AND.MAN6.LT.0) RP1=RM                                00002810
      IF(MAN1.EQ.5.AND.MAN6.GT.0) RA1=RM                                00002820
      REOR1=RA1-AS                                                      00002830
      REOR2=RP1-AS                                                      00002840
      IF(REOR1.LE.0.0.AND.REOR2.GE.0.) GO TO 77                         00002850
      NREOR=2                                                           00002860
      IF(MAN1.EQ.5.AND.MAN6.LT.0.AND.REOR1.GT.0.0.AND.REOR2.GT.0.)GOTO7700002870
      IF(MAN1.EQ.5.AND.MAN6.GT.0.AND.REOR1.LT.0.0.AND.REOR2.LT.0.)GOTO7700002880
      NREOR=1                                                           00002890
   77 DVREOR=NREOR*VREOR                                                00002900
      DVS=DVS+DVREOR                                                    00002910
      IF(NMLIST.NE.0) WRITE(6,560) DVS,NREOR                            00002920
  560 FORMAT(1X,'THE TOTAL DELTA-V INCLUDING REOR MANEUVERS=',D20.8,/   00002930
     1,' THERE WERE',I2,' REOR MANEUVERS',/)                            00002940
      RA=RA2                                                            00002950
      RP=RP2                                                            00002960
      A=A2                                                              00002970
      RETURN                                                            00002980
      END                                                               00002990
C          DATA SET DOT        AT LEVEL 002 AS OF 06/01/79
C          DATA SET DOT        AT LEVEL 001 AS OF 04/04/78              00001
      REAL FUNCTION DOT*8(X,Y)                                          00002
C                                                                       00003
C                                                                       00004
C     REAL FUNCTION DOT*8 (X,Y)                                         00005
C                                                                       00006
C                                                                       00007
C                                                                       00008
C     THE PURPOSE OF DOT IS TO DETERMINE THE DOT PRODUCT BETWEEN VECTOR 00009
C         X AND VECTOR Y.                                               00010
C                                                                       00011
C                                                                       00012
C                                                                       00013
C     ARGUMENTS IN THE CALLING SEQUENCE ARE DEFINED AS FOLLOWS.         00014
C                                                                       00015
C         ARGUMENT   TYPE    I/O        DEFINITION                      00016
C                                                                       00017
C          X(3)      R*8      I      FIRST VECTOR                       00018
C          Y(3)      R*8      I      SECOND VECTOR                      00019
C          DOT       R*8      O      DOT PRODUCT BETWEEN X AND Y        00020
C                                                                       00021
C                                                                       00022
C                                                                       00023
C     DOT IS CALLED BY THE FOLLOWING SUBROUTINES.                       00024
C                                                                       00025
C    ADOT  CVPROP  DELVS  GEOS  GEOSY  MINDVH  MISS  MODE2  ORB         00026
C    PREP  RANTAR  STEPD  VELASY                                        00027
C                                                                       00028
C                                                                       00029
C     NO SUBROUTINES ARE CALLED BY DOT.                                 00030
C                                                                       00031
C                                                                       00032
C                                                                       00033
C     DOT NEITHER USES NOR ALTERS VARIABLES IN COMMON. ALL INPUT AND    00034
C         OUTPUT IS THROUGH THE CALLING SEQUENCE.                       00035
C                                                                       00036
C                                                                       00037
C                                                                       00038
C                                                                       00039
      IMPLICIT REAL*8(A-H,O-Z)                                          00040
      DIMENSION X(3),Y(3)                                               00041
      DOT = X(1)*Y(1) + X(2)*Y(2) + X(3)*Y(3)                           00042
      RETURN                                                            00043
      END                                                               00044
C          DATA SET DRFTDV     AT LEVEL 003 AS OF 06/22/79
C          DATA SET DRFTDV     AT LEVEL 002 AS OF 06/01/79              00001
      SUBROUTINE DRFTDV(A,DDRIFT,DRIFT,DRTOL,DSMA,STAFI,AP,TUB,K)       00002
C                                                                       00003
C                                                                       00004
C     SUBROUTINE DRFTDV (A,DDRIFT,DRIFT,DRTOL,DSMA,STAF1,AP,TUB,U)      00005
C                                                                       00006
C                                                                       00007
C                                                                       00008
C     THE PURPOSE OF DRFTDV IS TO CALCULATE THE DELTA VELOCITY REQUIRED 00009
C         TO ACHEIVE A DESIRED DRIFT RATE.                              00010
C                                                                       00011
C                                                                       00012
C                                                                       00013
C     ARGUMENTS IN THE CALLING SEQUENCE ARE DEFINED AS FOLLOWS.         00014
C                                                                       00015
C         ARGUMENT   TYPE    I/O        DEFINITION                      00016
C                                                                       00017
C          A(1)      R*8     I/O     ECCENTRICITY                       00018
C          A(2)      R*8     I/O     SEMI-MAJOR AXIS                    00019
C          A(3-8)                    NOT USED                           00020
C          A(9)      R*8     I/O     DELTA VELOCITY CORRECTION          00021
C          DDRIFT    R*T      I      DESIRED DRIFT RATE                 00022
C                                                                       00023
C          DRIFT     R*8     I/O     DRIFT RATE ACHIEVED                00024
C          DRTOL     R*8      I      DRIFT RATE TOLERANCE               00025
C          DSMA      R*8      I      DESIRED SEMI-MAJOR AXIS            00026
C          STAF      R*8      I      STATION LONGITUDE                  00027
C          AP        R*8      I      APOGEE LONGITUDE                   00028
C          TUB       R*8      I      MAXIMUM TIME TO REACH STATION      00029
C                                       (DAYS)                          00030
C          K         R*8      I      MUST EQUAL ZERO                    00031
C                                                                       00032
C                                                                       00033
C                                                                       00034
C     DRFTDV IS CALLED BY THE FOLLOWING SUBROUTINES.                    00035
C                                                                       00036
C         GEOS      GEOSY                                               00037
C                                                                       00038
C                                                                       00039
C                                                                       00040
C                                                                       00041
C     NO SUBROUTINES ARE CALLED BY DRFTDV.                              00042
C                                                                       00043
C                                                                       00044
C                                                                       00045
C     DRFTDV NEITHER USES NOR ALTERS VARIABLES IN COMMON. ALL INPUT AND 00046
C         OUTPUT IS THROUGH THE CALLING SEQUENCE.                       00047
C                                                                       00048
C                                                                       00049
C                                                                       00050
      IMPLICIT REAL*8(A-H,O-Z)                                          00051
C                                                                       00052
C                                                                       00053
C                                                                       00054
C     VARIABLE DEFINITIONS                                              00055
C                                                                       00056
C                                                                       00057
C     A(1)   - ECCENTRICITY  - I/O                                      00058
C     DDRIFT - DESIRED DRIFT RATE - I                                   00059
C     DRIFT  - DRIFT RATE  - I/O                                        00060
C     DRTOL  - DRIFT RATE TOLERANCE - I                                 00061
C     DSMA   - DESIRED SEMI-MAJOR AXIS - I                              00062
C     A(2)   - SEMI-MAJOR AXIS  - I/O                                   00063
C     A(9)   - DELTA VELOCITY REQUIRED TO CORRECT - I/O                 00064
C                                                                       00065
C                                                                       00066
C                                                                       00067
      DATA XMU/398600.64D0/                                             00068
      DATA P1/3.14159265D0/,SDAY/86164.096D0/,TCOV/360.9856472D0/       00069
      DIMENSION A(9)                                                    00070
C                                                                       00071
C     STAFI = STATION POSITION, AP IS THE APOGEE POSITION               00072
C                                                                       00073
      IF(TUB.LT.0.D0) GO TO 1800                                        00074
           IF(K.GT.0)GOTO 1010                                          00075
      STAFIC = STAFI                                                    00076
      C36 = 360.D0                                                      00077
C                                                                       00078
C     COMPUTE ARC STAFI TO AP                                           00079
 1010 DLDR = STAFIC - AP                                                00080
      IF(DLDR)1020,1030,1030                                            00081
C     IF ARC LT 0 ADD 360 TO STAFIC                                     00082
 1020 STAFIC = STAFIC + C36                                             00083
      GO TO 1010                                                        00084
 1030 CONTINUE                                                          00085
C     IF COMPUTED DRIFT LT 0 DETERMINE DAYS TO DRIFT EAST               00086
C                                                                       00087
      IF(DRIFT)1100,1300,1300                                           00088
 1100 DE = DLDR / DABS(DRIFT)                                           00089
      IF(DE.LE.TUB) GO TO 1400                                          00090
C     INCREASE E-DRIFT TO REACH STAFI IN 24 DAYS                        00091
      RIFTEN = DRIFT * DE / TUB                                         00092
      GO TO 1410                                                        00093
 1400 RIFTEN = DRIFT                                                    00094
C     W-DRIFT IN 24 DAYS                                                00095
 1410 DRIFTW = (C36 - DLDR) / TUB                                       00096
 1450 CHK1 = DRIFT - RIFTEN                                             00097
      CHK2 = DRIFT - DRIFTW                                             00098
      IF(DABS(CHK1).GE.DABS(CHK2)) GO TO 1480                           00099
 1470 DDRIFT = RIFTEN                                                   00100
      GO TO 1800                                                        00101
 1480 DDRIFT = DRIFTW                                                   00102
      GO TO 1800                                                        00103
C     COMPUTED DRIFT GE 0 DETERMINE DAYS TO DRIFT WEST                  00104
C                                                                       00105
 1300 DW = (C36 - DLDR) / DRIFT                                         00106
      IF(DW.LE.TUB) GO TO 1500                                          00107
C     INCREASE W-DRIFT TO REACH STAFI IN 24 DAYS E-DRIFT IN 24 DAYS     00108
C                                                                       00109
      RIFTWN = DRIFT * DW/TUB                                           00110
      GO TO 1510                                                        00111
 1500 RIFTWN = DRIFT                                                    00112
 1510 DRIFTE =-DLDR / TUB                                               00113
 1550 CHK1 = DRIFT - RIFTWN                                             00114
      CHK2 = DRIFT - DRIFTE                                             00115
      IF(DABS(CHK1).GE.DABS(CHK2)) GO TO 1580                           00116
      DDRIFT = RIFTWN                                                   00117
      GO TO 1800                                                        00118
 1580 DDRIFT = DRIFTE                                                   00119
 1800 CONTINUE                                                          00120
      IF(TUB.GE.0.D0) GO TO 80                                          00121
      IF(DRTOL .NE. 0.D0) GO TO 300                                     00122
      IF(DDRIFT  .EQ. 0.D0) GO TO 110                                   00123
      SIGN=DRIFT/DDRIFT                                                 00124
      IF(SIGN .LT. 0.D0)GO TO 80                                        00125
      GO TO 200                                                         00126
  300 CONTINUE                                                          00127
      IF(DRTOL .LT. 0.D0) GO TO 85                                      00128
C  DETERMINE WHETHER OR NOT A DELTA-V CORRECTION IS NECESSARY           00129
      IF(DABS(DRIFT - DDRIFT).LE. DABS(DRTOL)) GO TO 110                00130
      GO TO 80                                                          00131
   85 CONTINUE                                                          00132
      IF((DABS(DRIFT)+DABS(DDRIFT)).NE.DABS(DRIFT+DDRIFT))DDRIFT=-DDRIFT00133
  200 IF(DABS(DRIFT)  .GE.  DABS(DDRIFT)) GO TO 110                     00134
   80 CONTINUE                                                          00135
      DRIFTP=DDRIFT                                                     00136
      PEROD=SDAY*(DRIFTP/(TCOV-DRIFTP) + 1.D0)                          00137
      DSMA=DEXP(DLOG(XMU*PEROD**2/(4.D0*P1**2))/3.D0)                   00138
      IF((DRIFT-DDRIFT).LT.0.D0) GO TO 90                               00139
      RR = A(2) * (1.D0 - A(1))                                         00140
      GO TO 100                                                         00141
   90 RR = A(2) * (1.D0 + A(1))                                         00142
C  COMPUTE THE VELOCITY MAGNITUDES AT THE MANEUVER POINT IN THE         00143
C  ACTUAL (VC) AND DESIRED (VD) ORBIT                                   00144
  100 VD  = DSQRT(XMU * (2.D0/RR - 1.D0/DSMA))                          00145
      VC  = DSQRT(XMU * (2.D0/RR - 1.D0/ A(2)))                         00146
      A(9)= DABS(VD - VC) + A(9)                                        00147
C  COMPUTE A AND E FOR THE DESIRED ORBIT                                00148
      A(2)=DSMA                                                         00149
      A(1) = DABS(1.D0 - RR/DSMA)                                       00150
  110 CONTINUE                                                          00151
      RETURN                                                            00152
      END                                                               00153
C          DATA SET EIGEN      AT LEVEL 001 AS OF 04/04/78
C                                                                       00000010
      SUBROUTINE EIGEN(AA,VALU,NR,M)                                    00000020
C                                                                       00000030
C                                                                       00000040
C     SUBROUTINE EIGEN (AA,VALU,NR,M)                                   00000050
C                                                                       00000060
C                                                                       00000070
C                                                                       00000080
C     THE PURPOSE OF EIGEN IS TO COMPUTE THE EIGENVALUES AND EIGENVECTOR00000090
C         OF A REAL SYMMETRIC MATRIX.                                   00000100
C                                                                       00000110
C                                                                       00000120
C                                                                       00000130
C     ARGUMENTS IN THE CALLING SEQUENCE ARE DEFINED AS FOLLOWS.         00000140
C                                                                       00000150
C         ARGUMENT   TYPE    I/O        DEFINITION                      00000160
C                                                                       00000170
C          AA(64)    R*8     I/O     INPUT, A REAL SYMMETRIC MATRIX, OF 00000180
C                                       SIZE NR BY NR                   00000190
C                                    OUTPUT, THE EIGENVECTORS OF THE    00000200
C                                       INPUT MATRIX                    00000210
C          VALU(8)   I*4      O      THE EIGENVALUES OF THE INPUT AA    00000220
C                                       MATRIX                          00000230
C          NR        I*4      I      THE DIMENSION SIZE OF THE INPUT AA 00000240
C                                       MATRIX                          00000250
C          M         I*4      I      M=0, NO EIGENVECTORS ARE COMPUTED  00000260
C                                    M 0, EIGENVECTORS OF INPUT AA      00000270
C                                       MATRIX ARE COMPUTED             00000280
C                                                                       00000290
C                                                                       00000300
C                                                                       00000310
C     EIGEN IS CALLED BY THE FOLLOWING SUBROUTINES.                     00000320
C                                                                       00000330
C         COVAR     MTXPR                                               00000340
C                                                                       00000350
C                                                                       00000360
C                                                                       00000370
C                                                                       00000380
C     NO SUBROUTINES ARE CALLED BY EIGEN.                               00000390
C                                                                       00000400
C                                                                       00000410
C                                                                       00000420
C     EIGEN NEITHER USES NOR ALTERS VARIABLES IN COMMON. ALL INPUT AND  00000430
C         OUTPUT IS THROUGH THE CALLING SEQUENCE.                       00000440
C                                                                       00000450
C                                                                       00000460
C                                                                       00000470
C                                                                       00000480
      IMPLICIT REAL*8 (A-H,O-Z)                                         00000490
      REAL*8 IND                                                        00000500
C     EIGENVALUES AND EIGENVECTORS OF A REAL SYMMETRIC MATRIX           00000510
C                                                                       00000520
C                                                                       00000530
      DIMENSION A(8,8),B(8,8),VALU(8),DIAG(8),SUPERD(7),Q(7),VALL(8)    00000540
     1,S(7),C(7),D(8),IND(8),U(8),DUMMY(94),AA(64)                      00000550
      EQUIVALENCE (DIAG(1),DUMMY(1)),(SUPERD(1),DUMMY(9)),              00000560
     1(VALL(1),D(1),DUMMY(16)),(Q(1),S(1),DUMMY(24)),(B(1,1),DUMMY(31)),00000570
     2 (IND(1),U(1)),(II,MATCH),(TAU,BETA),(P,PRODS),(T,SMALLD),        00000580
     3 (ANORM,ANORM2)                                                   00000590
      SQRT(X)=DSQRT(X)                                                  00000600
      SIN(Y)=DSIN(Y)                                                    00000610
      COS(Z)=DCOS(Z)                                                    00000620
      ABS(A)=DABS(A)                                                    00000630
C                                                                       00000640
C     CALCULATE NORM OF MATRIX                                          00000650
C                                                                       00000660
      N=NR                                                              00000670
      ORMA = 0.D0                                                       00000680
      J =1                                                              00000690
      DO 1001 I=1,7                                                     00000700
      SUPERD(I)=0.D0                                                    00000710
 1001 CONTINUE                                                          00000720
      CUS=1.D0                                                          00000730
      SUN=0.D0                                                          00000740
      DO 1 I=1,N                                                        00000750
      ORMA = ORMA+AA(J)                                                 00000760
1     J=J+N+1                                                           00000770
      DO 2 I=1,N                                                        00000780
      NI=N*(I-1)                                                        00000790
      DO 2 J=1,N                                                        00000800
      IJ=NI+J                                                           00000810
2     A(J,I) = AA(IJ)/ORMA                                              00000820
    3 ANORM2=0.0D0                                                      00000830
    4 DO 6 I=1,N                                                        00000840
    5 DO 6 J=1,N                                                        00000850
    6 ANORM2=ANORM2+A(I,J)**2                                           00000860
    7 ANORM=SQRT (ANORM2)                                               00000870
C                                                                       00000880
C     GENERATE IDENTITY MATRIX                                          00000890
C                                                                       00000900
    9 IF (M) 10, 45, 10                                                 00000910
   10 DO 40 I=1,N                                                       00000920
   12 DO 40 J=1,N                                                       00000930
   20 IF(I-J) 35, 25, 35                                                00000940
   25 B(I,J)=1.0D0                                                      00000950
   30 GO TO 40                                                          00000960
   35 B(I,J)=0.0D0                                                      00000970
   40 CONTINUE                                                          00000980
C                                                                       00000990
C     PERFORM ROTATIONS TO REDUCE MATRIX TO JACOBI FORM                 00001000
C                                                                       00001010
   45 IEXIT=1                                                           00001020
   50 NN=N-2                                                            00001030
   52 IF (NN) 890, 170, 55                                              00001040
   55 DO 160 I=1,NN                                                     00001050
   60 II=I+2                                                            00001060
   65 DO 160 J=II,N                                                     00001070
   70 T1=A(I,I+1)                                                       00001080
   75 T2=A(I,J)                                                         00001090
   80 GO TO 900                                                         00001100
   90 DO 105 K=I,N                                                      00001110
   95 T2=CUS*A(K,I+1)+SUN*A(K,J)                                        00001120
  100 A(K,J)=CUS*A(K,J)-SUN*A(K,I+1)                                    00001130
  105 A(K,I+1)=T2                                                       00001140
  110 DO 125 K=I,N                                                      00001150
  115 T2=CUS*A(I+1,K)+SUN*A(J,K)                                        00001160
  120 A(J,K)=CUS*A(J,K)-SUN*A(I+1,K)                                    00001170
  125 A(I+1,K)=T2                                                       00001180
  128 IF (M) 130, 160, 130                                              00001190
  130 DO 150 K=1,N                                                      00001200
  135 T2=CUS*B(K,I+1)+SUN*B(K,J)                                        00001210
  140 B(K,J)=CUS*B(K,J)-SUN*B(K,I+1)                                    00001220
  150 B(K,I+1)=T2                                                       00001230
  160 CONTINUE                                                          00001240
C                                                                       00001250
C     MOVE JACOBI FORM ELEMENTS AND INITIALIZE EIGENVALUE BOUNDS        00001260
C                                                                       00001270
  170 DO 200 I=1,N                                                      00001280
  180 DIAG(I)=A(I,I)                                                    00001290
  190 VALU(I)=ANORM                                                     00001300
  200 VALL(I)=-ANORM                                                    00001310
  210 DO 230 I=2,N                                                      00001320
  220 SUPERD(I-1)=A(I-1,I)                                              00001330
  230 Q(I-1)=(SUPERD(I-1))**2                                           00001340
C                                                                       00001350
C     DETERMINE SIGNS OF PRINCIPAL MINORS                               00001360
C                                                                       00001370
  235 TAU=0.0D0                                                         00001380
  240 I=1                                                               00001390
  260 MATCH=0                                                           00001400
  270 T2=0.0D0                                                          00001410
  275 T1=1.0D0                                                          00001420
  277 DO 450 J=1,N                                                      00001430
  280 P=DIAG(J)-TAU                                                     00001440
  290 IF(T2) 300, 330, 300                                              00001450
  300 IF(T1) 310, 370, 310                                              00001460
  310 T=P*T1-Q(J-1)*T2                                                  00001470
  320 GO TO 410                                                         00001480
  330 IF(T1) 335, 350, 350                                              00001490
  335 T1=-1.0D0                                                         00001500
  340 T=-P                                                              00001510
  345 GO TO 410                                                         00001520
  350 T1=1.0D0                                                          00001530
  355 T=P                                                               00001540
  360 GO TO 410                                                         00001550
  370 IF(Q(J-1)) 380, 350, 380                                          00001560
  380 IF(T2) 400, 390, 390                                              00001570
  390 T=-1.0D0                                                          00001580
  395 GO TO 410                                                         00001590
  400 T=1.0D0                                                           00001600
C                                                                       00001610
C     COUNT AGREEMENTS IN SIGN                                          00001620
C                                                                       00001630
  410 IF(T1) 425, 420, 420                                              00001640
  420 IF(T) 440, 430, 430                                               00001650
  425 IF(T) 430, 440, 440                                               00001660
  430 MATCH=MATCH+1                                                     00001670
  440 T2=T1                                                             00001680
  450 T1=T                                                              00001690
C                                                                       00001700
C     ESTABLISH TIGHTER BOUNDS ON EIGENVALUES                           00001710
C                                                                       00001720
  460 DO 530 K=1,N                                                      00001730
  465 IF (K-MATCH) 470, 470, 520                                        00001740
  470 IF(TAU-VALL(K)) 530, 530, 480                                     00001750
  480 VALL(K)=TAU                                                       00001760
  490 GO TO 530                                                         00001770
  520 IF(TAU-VALU(K)) 525, 530, 530                                     00001780
  525 VALU(K)=TAU                                                       00001790
  530 CONTINUE                                                          00001800
  540 IF (VALU(I)-VALL(I)-5.0D-16) 570,570,550                          00001810
  550 IF(VALU(I)) 560, 580, 560                                         00001820
  560 IF (ABS(VALL(I)/VALU(I)-1.0D0)-5.0D-16) 570,570,580               00001830
  570 I=I+1                                                             00001840
  575 IF(I-N) 540, 540, 590                                             00001850
  580 TAU=(VALL(I)+VALU(I))/2.0D0                                       00001860
  585 GO TO 260                                                         00001870
C                                                                       00001880
C     JACOBI EIGENVECTORS BY ROTATIONAL TRIANGULARIZATION               00001890
C                                                                       00001900
  590 IF (M) 593, 890, 593                                              00001910
  593 IEXIT=2                                                           00001920
  595 DO 610 I=1,N                                                      00001930
  600 DO 610 J=1,N                                                      00001940
  610 A(I,J)=0.0D0                                                      00001950
  615 DO 850 I=1,N                                                      00001960
  620 IF (I-1) 625, 625, 621                                            00001970
  621 IF (VALU(I-1)-VALU(I)-5.0D-14) 730,730,622                        00001980
  622 IF (VALU(I-1)) 623, 625, 623                                      00001990
  623 IF (ABS(VALU(I)/VALU(I-1)-1.0D0)-5.0D-14) 730,730,625             00002000
  625 CUS=1.0D0                                                         00002010
  628 SUN=0.0D0                                                         00002020
  630 DO 700 J=1,N                                                      00002030
  635 IF(J-1) 680, 680, 640                                             00002040
  640 GO TO 900                                                         00002050
  650 S(J-1)=SUN                                                        00002060
  660 C(J-1)=CUS                                                        00002070
  670 D(J-1)=T1*CUS+T2*SUN                                              00002080
  680 T1=(DIAG(J)-VALU(I))*CUS-BETA*SUN                                 00002090
  690 T2=SUPERD(J)                                                      00002100
  700 BETA=SUPERD(J)*CUS                                                00002110
  710 D(N)=T1                                                           00002120
  720 DO 725 J=1,N                                                      00002130
  725 IND(J)=0.0D0                                                      00002140
  730 SMALLD=ANORM                                                      00002150
  735 DO 780 J=1,N                                                      00002160
  740 IF(IDINT(IND(J))-1) 750,780,780                                   00002170
  750 IF (ABS (SMALLD)-ABS (D(J)))780, 780, 760                         00002180
  760 SMALLD=D(J)                                                       00002190
  770 NN=J                                                              00002200
  780 CONTINUE                                                          00002210
  790 IND(NN)=1.0D0                                                     00002220
  800 PRODS=1.0D0                                                       00002230
  805 IF (NN-1) 810, 850, 810                                           00002240
  810 DO 840 K=2,NN                                                     00002250
  820 II=NN+1-K                                                         00002260
  830 A(II+1,I)=C(II)*PRODS                                             00002270
  840 PRODS=-PRODS*S(II)                                                00002280
  850 A(1,I)=PRODS                                                      00002290
C                                                                       00002300
C     FORM MATRIX PRODUCT OF ROTATION MATRIX WITH JACOBI VECTOR MATRIX  00002310
C                                                                       00002320
  855 DO 885 J=1,N                                                      00002330
  860 DO 865 K=1,N                                                      00002340
  865 U(K)=A(K,J)                                                       00002350
  870 DO 8851 I=1,N                                                     00002360
  875 A(I,J)=0.0D0                                                      00002370
  880 DO 8852 K=1,N                                                     00002380
      A(I,J)=B(I,K)*U(K)+A(I,J)                                         00002390
 8852 CONTINUE                                                          00002400
 8851 CONTINUE                                                          00002410
  885 CONTINUE                                                          00002420
      DO 886 I=1,N                                                      00002430
      NI=N*(I-1)                                                        00002440
      DO 886 J=1,N                                                      00002450
      IJ=NI+J                                                           00002460
886   AA(IJ)=A(J,I)                                                     00002470
890   CONTINUE                                                          00002480
      DO 891 I=1,N                                                      00002490
891   VALU(I) = VALU(I)*ORMA                                            00002500
      RETURN                                                            00002510
C                                                                       00002520
C     CALCULATE SINE AND COSINE OF ANGLE OF ROTATION                    00002530
C                                                                       00002540
  900 IF (T2) 910, 940, 910                                             00002550
  910 T=SQRT (T1**2+T2**2)                                              00002560
  920 CUS=T1/T                                                          00002570
  925 SUN=T2/T                                                          00002580
  930 GO TO (90,650), IEXIT                                             00002590
  940 GO TO (160,910), IEXIT                                            00002600
      RETURN                                                            00002610
      END                                                               00002620
C          DATA SET FINDV      AT LEVEL 003 AS OF 06/22/79
C          DATA SET FINDV      AT LEVEL 002 AS OF 06/01/79              00001
      SUBROUTINE FINDV(XI,FXI,IC)                                       00002
C                                                                       00003
C                                                                       00004
C     SUBROUTINE FINDV (XI,FXI,IC)                                      00005
C                                                                       00006
C                                                                       00007
C                                                                       00008
C  THE PURPOSE OF FINDV IS TO FIND A LOCAL MINIMUM, MAXIMUM, OR ZERO    00009
C  OF A FUNCTION F(X) OF A SCALAR X. NOTE THAT THE SUBROUTINE           00010
C  TAKES ONLY ONE STEP TOWARD THE CHOSEN GOAL FOR EACH ENTRY.           00011
C                                                                       00012
C                                                                       00013
C                                                                       00014
C     ARGUMENTS IN THE CALLING SEQUENCE ARE DEFINED AS FOLLOWS.         00015
C                                                                       00016
C         ARGUMENT   TYPE    I/O        DEFINITION                      00017
C                                                                       00018
C          XI(1)     R*8     I/O     INITIAL VALUE OF X                 00019
C          XI(2)     R*8      I      LOWER BOUNDARY OF X                00020
C          XI(3)     R*8      I      UPPER BOUNDARY OF X                00021
C          XI(4)     R*8      O      LAST VALUE OF X                    00022
C          XI(5)     R*8      O      NEXT TO THE LAST VALUE OF X        00023
C          XI(6)     R*8      O      TOLERANCE USED ON INCREMENTAL      00024
C                                       CHANGE OF X                     00025
C          FXI(1)    R*8      I      VALUE OF F(X)                      00026
C     GAUSS NEITHER USES NOR ALTERS VARIABLES IN COMMON. ALL INPUT AND  00027
C          IKEY      I*4      I      IKET=-1, DEFAULT STARTING VALUE    00028
C          FXI(2)    R*8      I      TOLERANCE OF SOLUTION              00029
C          FXI(3)    R*8     I/O     INITIAL STEP SIZE IN X             00030
C          FXI(4)    R*8      O      VALUE OF F(X) FOR XI(4)            00031
C          FXI(5)    R*8      O      VALUE OF F(X) FOR XI(5)            00032
C          FXI(6)    R*8      O      INITIAL VALUE OF F(X)              00033
C          IC(1)     I*4     I/O     MUST EQUAL -1 ON FIRST CALL TO     00034
C                                       FINDV; THEN VALUES CAN BE       00035
C                                       =0, NORMAL EXIT FOR NEW F(X)    00036
C                                       =-1, CONVERGENCE                00037
C                                       =1, EXCEEDED MAXIMUM NUMBER OF  00038
C                                       ITERATIONS                      00039
C                                       =2, PROGRAM HAS TRIED 3 TIMES   00040
C                                       TO STEP PAST A BOUNDARY         00041
C          IC(2)     I*4      I      MAXIMUM NUMBER OF ITERATIONS       00042
C          IC(3)     I*4      O      PRESENT ITERATION NUMBER           00043
C          IC(4)     I*4      I      OPTION FLAG                        00044
C                                       =0, FIND A ZERO OF F(X)         00045
C                                       =1, FIND A MINIMUM OF F(X) OR A 00046
C                                       MAXIMUM OF -F(X)                00047
C          IC(5)     I*4      O      =1, USE STEP MODE                  00048
C                                       =2, USE PAROBOLIC MODE          00049
C                                       =0, FIT IS BEYOND BOUNDARY      00050
C                                       >0, FIT IS AGAINST BOUNDARY     00051
C                                                                       00052
C                                                                       00053
C                                                                       00054
C     FINDV IS CALLED BY THE FOLLOWING SUBROUTINES.                     00055
C                                                                       00056
C         MINDVH    CONBR                                               00057
C                                                                       00058
C                                                                       00059
C                                                                       00060
C     NO SUBROUTINES ARE CALLED BY FINDV.                               00061
C                                                                       00062
C                                                                       00063
C                                                                       00064
C     FINDV NEITHER USES NOR ALTERS VARIABLES IN COMMON. ALL INPUT AND  00065
C         OUTPUT IS THROUGH THE CALLING SEQUENCE.                       00066
C                                                                       00067
C                                                                       00068
C                                                                       00069
      IMPLICIT REAL*8(A-H,O-Z,$)                                        00070
      DIMENSION XI(6),X(6),FXI(6),FX(6),IC(6),II(6)                     00071
C     FINDS VALUE OF X WHICH                                            00072
C     M=0  FX=0                                                         00073
C     M=1  MINIMIZES FX                                                 00074
C     XL=LOWER BOUNDRY OF X                                             00075
C     XU=UPPER BOUNDRY OF X                                             00076
C     E=ERROR TOLERANCE                                                 00077
C     IK=INITIALIZATION AND SOLUTION FOUND KEY                          00078
C     NM=MAX NUMBER OF ITERATIONS                                       00079
C     XI(1)=VALUE OF X                                                  00080
C     XI(2)=VALUE OF XL                                                 00081
C     XI(3)=VALUE OF XU                                                 00082
C     XI(4)=LAST VALUE OF XI(1)                                         00083
C     XI(5)=LAST VALUE OF XI(4)                                         00084
C     XI(6)= TOLERANCE USED ON INCREMENTAL CHANGE OF X SET BY PROGRAM   00085
C     FXI(1)=VALUE OF FX                                                00086
C     FXI(2)=TOLERANCE OF SOLUTION                                      00087
C     FXI(3)=STEP SIZE OF X                                             00088
C     FXI(4)=VALUE OF FX FOR XI(4)                                      00089
C     FXI(5)=VALUE OF FX FOR XI(5)                                      00090
C     FXI(6)=STARTING VALUE OF FX                                       00091
C     IC(1)=INITIAL AND TYPE STOP KEY=IK                                00092
C     IC(2)=MAX NUMBER OF ITERATIONS=NM                                 00093
C     IC(3)=RUNNING NUMBER OF ITERATIONS=N                              00094
C     IC(4)=M                                                           00095
C     IC(5)=LOGIC KEY =JK                                               00096
C     JK=1 IS THE STEP MODE                                             00097
C     JK=2 IS THE PARABOLIC FIT MODE                                    00098
C     IC(6)=LOGIC KEY =IB                                               00099
C     IB=0 THE MAX MIN OR ZERO IS AWAY FROM THE BOUNDRY                 00100
C     IB=1,2,OR3  THE FIT IS AGAINST THE BOUNDRY                        00101
      EQUIVALENCE(X(2),XL),(FX(2),E),(II(1),IK)                         00102
     1,          (X(3),XU),(FX(3),SS),(II(2),NM)                        00103
     2,          (X(4),XP),(FX(4),FP),(II(3),N)                         00104
     3,          (X(5),XPP),(FX(5),FPP),(II(4),M)                       00105
     4,          (X(6),XO),(FX(6),FO),(II(5),JK)                        00106
     5,                              (II(6),IB)                         00107
      DO 1 I=1,6                                                        00108
      II(I)=IC(I)                                                       00109
      X(I)=XI(I)                                                        00110
      FX(I)=FXI(I)                                                      00111
1     CONTINUE                                                          00112
      IF(IK)2,3,3                                                       00113
 2    CONTINUE                                                          00114
C  COMPUTE THE TOLERANCE USED ON THE INCREMENTAL CHANGE IN X.           00115
      XO=DABS (SS)*.025D0                                               00116
C  INITIAL VALUE OF THE FUNCTION, F(X), FOR THIS ITERATION              00117
      FO=FX(1)                                                          00118
      N=0                                                               00119
      IK=0                                                              00120
      JK=1                                                              00121
      IB=0                                                              00122
      GO TO 40                                                          00123
3     CONTINUE                                                          00124
C  TEST ON M:                                                           00125
C  M < 0 OR M=0 INDICATES THE OPTION DESIRED IS TO FIND THE VALUE       00126
C  OF X, SUCH THAT F(X)=0.  M > 0 INDICATES THAT THE DESIRE IS TO       00127
C  FIND THE VALUE OF X WHICH MINIMIZES F(X)                             00128
      IF(M)4,4,20                                                       00129
4     CONTINUE                                                          00130
C  JK SIGNALS WHETHER FINDV IS IN THE STEP MODE (JK=1) OR THE           00131
C  PARABOLIC FIT MODE (JK=2).                                           00132
      GO TO (5,7),JK                                                    00133
5     CONTINUE                                                          00134
C  IF THE PRODUCT=0, THE ZERO VALUE OF THE FUNCTION HAS BEEN FOUND.     00135
C  IF THE PRODUCT < 0, WHICH INDICATES THE ZERO OF THE FUNCTION HAS     00136
C  BEEN PASSED THROUGH, THE X VALUE WILL BE INCREMENTED BY -SS/2        00137
      IF(FO*FX(1))6,50,40                                               00138
6     CONTINUE                                                          00139
      SS=-SS/2.0D0                                                      00140
      JK=2                                                              00141
       IF(N-1) 40,25,40                                                 00142
7     CONTINUE                                                          00143
      IF(DABS(FX(1))-E)50,50,25                                         00144
 8    CONTINUE                                                          00145
      IF(FX(1)*FP.LT.FX(1)*FPP) GO TO 85                                00146
C     FX AND FPP ARE OF OPPOSITE SIGN                                   00147
      XP=XPP                                                            00148
      FP=FPP                                                            00149
   85 CONTINUE                                                          00150
      A2=A2/A1                                                          00151
      D1=A2*FX(1)/A1                                                    00152
      IF(DABS(D1).LT..025D0) GO TO 9                                    00153
      D2=DSQRT(1.D0-4.D0*D1)                                            00154
      A2=-.5D0/A2                                                       00155
      SS=A2*(1.0D0-D2)                                                  00156
      IF(DXR.GT.0.D0.AND.SS*DX1.LT.0.D0) SS=A2*(1.0D0+D2)               00157
      GO TO 40                                                          00158
    9 SS=-FX(1)*(1.D0+D1)/A1                                            00159
      GO TO 40                                                          00160
20    CONTINUE                                                          00161
      GO TO(21,25),JK                                                   00162
21    CONTINUE                                                          00163
      IF(N-2)40,22,22                                                   00164
C  IF THE CONDITIONS AA < 0 AND FP-FX(1) < 0 ARE BOTH MET, THIS         00165
C  NORMALLY WILL INDICATE THAT XP IS NEARING THE VALUE OF X THAT        00166
C  MINIMIZES F(X).                                                      00167
22    AA=FP-(FPP+FX(1))/2.D0                                            00168
      IF(AA)23,40,27                                                    00169
23    CONTINUE                                                          00170
      IF(FP-FX(1))25,40,40                                              00171
25    CONTINUE                                                          00172
      NN=0                                                              00173
      I=1                                                               00174
      J=4                                                               00175
252   NN=NN+1                                                           00176
      IF (M)100,100,101                                                 00177
100   IF(DABS (FX(I))-DABS (FX(J)))254,254,253                          00178
101   CONTINUE                                                          00179
      IF(FX(I)-FX(J))254,254,253                                        00180
253   A1=X(J)                                                           00181
      A2=FX(J)                                                          00182
      FX(J)=FX(I)                                                       00183
      X(J)=X(I)                                                         00184
      X(I)=A1                                                           00185
      FX(I)=A2                                                          00186
       SS=-SS                                                           00187
254   I=4                                                               00188
       IF(N.EQ.1) GO TO 40                                              00189
      J=5                                                               00190
      GO TO(252,255),NN                                                 00191
255   SS=X(1)-X(4)                                                      00192
  250 DX1=(XP-X(1))+1.D-6                                               00193
      DX2=(XPP-X(1))+1.D-8                                              00194
      D1=FP-FX(1)                                                       00195
      D2=FPP-FX(1)                                                      00196
      DXR=DX1/DX2                                                       00197
      DET=DX2-DX1                                                       00198
      A1=(D1/DXR-D2*DXR)/DET                                            00199
      A2=(D2/DX2-D1/DX1)/DET                                            00200
      IF(M)8,8,28                                                       00201
28    CONTINUE                                                          00202
      DS=-A1/A2/2.D0                                                    00203
      DET=(DABS (DX1)+DABS (DX2))/2.D0                                  00204
      IF(DABS (DS)-DET     )262,262,261                                 00205
261   CONTINUE                                                          00206
      DS=-DSIGN(1.D0,D1/DX1)*DET                                        00207
      GO TO 26                                                          00208
262   CONTINUE                                                          00209
      GO TO(26,251),JK                                                  00210
251   CONTINUE                                                          00211
      IF(DABS (DS)-XO)266,266,26                                        00212
266   CONTINUE                                                          00213
      DET=E+.0001D0*DABS (FX(1))                                        00214
      IF(DABS (A1*DS+A2*DS*DS)-DET)50,50,26                             00215
26    CONTINUE                                                          00216
      SS=DS                                                             00217
      JK=2                                                              00218
27    CONTINUE                                                          00219
40    CONTINUE                                                          00220
      XPP=XP                                                            00221
      XP=X(1)                                                           00222
      FPP=FP                                                            00223
      FP=FX(1)                                                          00224
41    CONTINUE                                                          00225
C  MODIFICATIONS OF STEP SIZE NEAR A BOUNDARY:  IF X+DX LIES OUTSIDE    00226
C  THE INTERVAL (XL,XU), THE ROUTINE RECOMPUTES DX=SS USING SS=.9(XL-XP)00227
C  OR SS=.9(XU-XP).  THREE SUCH ADJUSTMENTS (COUNTED BY IB) CAUSES      00228
C  IK TO BE SET EQUAL TO 2.                                             00229
      X(1)=X(1)+SS                                                      00230
      IF(X(1)-XL)42,42,43                                               00231
42    CONTINUE                                                          00232
      SS=.9D0*(XL-XP)                                                   00233
      GO TO 46                                                          00234
43    CONTINUE                                                          00235
      IF(X(1)-XU)47,45,45                                               00236
45    CONTINUE                                                          00237
      SS=.9D0*(XU-XP)                                                   00238
46    IB=IB+1                                                           00239
      X(1)=XP+SS                                                        00240
      IF(IB-3)47,49,49                                                  00241
47    CONTINUE                                                          00242
      IF(N-NM)60,48,48                                                  00243
48    IK=1                                                              00244
      GO TO 60                                                          00245
49    IK=2                                                              00246
      GO TO 60                                                          00247
50    IK=-1                                                             00248
60    CONTINUE                                                          00249
      N=N+1                                                             00250
      DO 61 I=1,6                                                       00251
      XI(I)=X(I)                                                        00252
      FXI(I)=FX(I)                                                      00253
61    IC(I)=II(I)                                                       00254
      RETURN                                                            00255
      END                                                               00256
C          DATA SET FNORM      AT LEVEL 001 AS OF 04/04/78
C                                                                       00000010
      REAL FUNCTION FNORM*8(X)                                          00000020
C                                                                       00000030
C                                                                       00000040
C     REAL FUNCTION FNORM*8(X)                                          00000050
C                                                                       00000060
C                                                                       00000070
C                                                                       00000080
C     THE PURPOSE OF FNORM IS TO COMPUT THE MAGNITUDE OF A VECTOR X.    00000090
C                                                                       00000100
C                                                                       00000110
C                                                                       00000120
C     ARGUMENTS IN THE CALLING SEQUENCE ARE DEFINED AS FOLLOWS          00000130
C                                                                       00000140
C         ARGUMENT   TYPE    I/O        DEFINITION                      00000150
C                                                                       00000160
C          X(3)      R*8      I      THE VECTOR WHOSE MAGNITUDE IS TO   00000170
C                                       BE CALCULATED                   00000180
C                                                                       00000190
C                                                                       00000200
C                                                                       00000210
C     FNORM IS CALLED BY THE FOLLOWING SUBROUTINES.                     00000220
C                                                                       00000230
C         BURNST    CONVET    CVPROP    DELVS     GEOS      MINDVH      00000240
C         MTXPR     PARTAL    PREP      TFY                             00000250
C                                                                       00000260
C                                                                       00000270
C                                                                       00000280
C                                                                       00000290
C     NO SUBROUTINES ARE CALLED BY FNORM.                               00000300
C                                                                       00000310
C                                                                       00000320
C                                                                       00000330
C     FNORM NEITHER USES NOR ALTERS VARIABLES IN COMMON. ALL INPUT AND  00000340
C         OUTPUT IS THROUGH THE CALLING SEQUENCE.                       00000350
C                                                                       00000360
C                                                                       00000370
C                                                                       00000380
C                                                                       00000390
      IMPLICIT REAL*8(A-H,O-Z)                                          00000400
      DIMENSION X(3)                                                    00000410
    1 FNORM =DSQRT(X(1)**2+X(2)**2+X(3)**2)                             00000420
    3 RETURN                                                            00000430
      END                                                               00000440
C          DATA SET GAUSS      AT LEVEL 002 AS OF 06/19/79
C          DATA SET GAUSS      AT LEVEL 001 AS OF 04/04/78              00001
C                                                                       00002
      SUBROUTINE GAUSS(/IX/,S,AM,V,H)                                   00003
C                                                                       00004
C                                                                       00005
C     SUBROUTINE GAUSS (IX,S,AM,V,H)                                    00006
C                                                                       00007
C                                                                       00008
C                                                                       00009
C     THE PURPOSE OF GAUSS IS TO CALCULATE A RANDOM OBSERVATION FROM AN 00010
C         APPROXIMATELY NORMAL DISTRIBUTION OF RANDOM NUMBERS.          00011
C                                                                       00012
C                                                                       00013
C                                                                       00014
C     ARGUMENTS IN THE CALLING SEQUENCE ARE DEFINED AS FOLLOWS.         00015
C                                                                       00016
C         ARGUMENT   TYPE    I/O        DEFINITION                      00017
C                                                                       00018
C          IX        I*4     I/O     RANDOM NUMBER FROM A NORMAL        00019
C                                       DISTRIBUTION                    00020
C          S         R*8      I      STANDARD DEVIATION                 00021
C          AM        R*8      I      MEAN                               00022
C          V         R*8      O      RANDOM OBSERVATION                 00023
C          H         R*8      I      NUMBER OF RANDOM NUMBERS GENERATED 00024
C                                       FOR EACH OBSERVATION            00025
C                                                                       00026
C                                                                       00027
C                                                                       00028
C     GAUSS IS CALLED BY THE FOLLOWING SUBROUTINES.                     00029
C                                                                       00030
C         BARN1                                                         00031
C                                                                       00032
C                                                                       00033
C                                                                       00034
C                                                                       00035
C     THE FOLLOWING SUBROUTINE IS CALLED BY GAUSS.                      00036
C                                                                       00037
C         RANDU                                                         00038
C                                                                       00039
C                                                                       00040
C                                                                       00041
C     GAUSS NEITHER USES NOR ALTER VARIABLES IN COMMON. ALL INPUT AND   00042
C         OUTPUT IS THROUGH THE CALLING SEQUENCE.                       00043
C                                                                       00044
C                                                                       00045
      IMPLICIT REAL*8(A-H,O-Z)                                          00046
      K=H                                                               00047
      A=0.0D0                                                           00048
      DO 50 I=1,K                                                       00049
C  RANDU COMPUTES THE VALUE OF Y, WHICH IS A RANDOM NUMBER              00050
C  BETWEEN 0 AND 1 FOUND FROM A NORMAL DISTRIBUTION                     00051
      CALL RANDU(IX,IY,Y)                                               00052
      IX=IY                                                             00053
   50 A=A+Y                                                             00054
      HO=H/12.                                                          00055
      H2=H/2.                                                           00056
C  COMPUTE THE VALUE OF THE RANDOM OBSERVATION, USING THE CENTRAL       00057
C  LIMIT THEOREM                                                        00058
      V=(S*(A-H2))/DSQRT(HO)+AM                                         00059
      RETURN                                                            00060
      END                                                               00061
C          DATA SET GEOSX      AT LEVEL 012 AS OF 04/09/79              00000010
C          DATA SET GEOSX      AT LEVEL 010 AS OF 02/26/79              00000020
C          DATA SET GEOS       AT LEVEL 024 AS OF 11/22/78              00000030
C          DATA SET GEOS       AT LEVEL 019 AS OF 05/25/78              00000040
C          DATA SET GEOS       AT LEVEL 011 AS OF 05/02/78              00000050
      SUBROUTINE GEOS(B,K,ELH)                                          00000060
C                                                                       00000080
C     SUBROUTINE GEOS (B,K,ELH)                                         00000090
C                                                                       00000120
C     THE PURPOSE OF GEOS IS TO SIMULATE A GEOSYNCHRONOUS MISSION FROM  00000130
C         TRANSFER ORBIT INJECTION THROUGH STATION ACQUISITION.         00000140
C                                                                       00000170
C     ARGUMENTS IN THE FOLLOWING SEQUENCE ARE DEFINED AS FOLLOWS.       00000180
C                                                                       00000190
C        ARGUMENTS   TYPE    I/O        DEFINITION                      00000200
C         B(50)      R*8      O      ARRAY CONTAINING TRAJECTORY        00000220
C                                       PARAMETERS                      00000230
C         K          I*4      I      K=0, WRITE OUT THE GEOSYNCHRONOUS  00000240
C                                       MODE INPUTS,.AND INITIALIZE     00000250
C                                       INTERNAL PROGRAM VARIABLES WITH 00000260
C                                       INPUT VALUES K>0, SKIP THE WRITE00000270
C                                       AND INITIALIZATION STATEMENTS   00000280
C         ELH(50)    R*8      O      ARRAY CONTAINING OUTPUT TITLES     00000290
C                                       CORRESPONDING TO THE B ARRAY    00000300
C                                                                       00000320
C     GEOS IS CALLED BY THE FOLLOWING SUBROUTINES.                      00000340
C                                                                       00000350
C         MAIN                                                          00000360
C                                                                       00000370
C     THE FOLLOWING SUBROUTINES ARE CALLED BY GEOS.                     00000410
C                                                                       00000420
C     CONVET  DELVS  DOT  DRFTDV  MTXPR  ORB  OUTPUT  PREP  RANDOM      00000430
C         SARA    STEPD                                                 00000440
C                                                                       00000460
C     THE FOLLOWING FUNCTION SUBPROGRAMS ARE CALLED BY GEOS.            00000480
C                                                                       00000490
C         FNORM     VNORM                                               00000500
C                                                                       00000510
C     THE VARIABLES APPEARING IN COMMON BLOCKS ARE TABULATED BELOW.     00000540
C                                                                       00000550
C         COMMON VARIABLES USED                                         00000560
C                                                                       00000570
C         AINSY1    ASM       ESM       ISCFLAG   R2D       WA          00000580
C         AINTR1    DELNO1    FIS       ITOPT     SDAY      W1          00000590
C         AIS       DIS       GO        LEG       SIGB1(3)  X11         00000600
C         ALAMD1    DNS       IFLAG     LU9       STAF1     XISP1       00000610
C         ALD       DRTOL     IGUID1    NAMES     TAMAN     XISP4       00000620
C         ALF       DVIN1     IKEY      NCONF     TCOV      XKM2K       00000630
C         AL1       DVN1      IP1COR    P1        THRUS1    XMU         00000640
C         AP        D2R       IP2COR    PITCH1    TUB       YAW1        00000650
C         AS        ES                                                  00000660
C                                                                       00000670
C         COMMON VARIABLES USED AND COMPUTED                            00000680
C                                                                       00000690
C         DSMA      P11(6,6)  P21(6,6)  SNODE     TERR      XB(6)       00000700
C         IFRN                                                          00000710
C                                                                       00000720
      IMPLICIT REAL*8(A-H,O-Z)                                          00000750
      REAL*8  NAMES,ZU,ZM                                               00000760
      REAL*4 ZUB,ZDELT                                                  00000770
      COMMON /CONST/ S2LB,D2R,XPI,R2D,F2KM,XKM2F,G0                     00000780
      COMMON /GENRL/ P1,PI(6,6),XIS(6),XMU,NAMES(6),PITCHI,YAWI,WI,     00000790
     A P1I(6,6),P2I(6,6),P3I(6,6),P4I(6,6),P5I(6,6),P6I(6,6),TOLR(50),  00000800
     * THRUSI,SIGBI(3),ZDELT,ZUB(3,50),                                 00000810
     B IP1COR,IP2COR,IP3COR,IP4COR,IP5COR,IP6COR,                       00000820
     1 ICOV(50),IHIST(50),IPCOOR,ITPSTR,NCONF,MODE                      00000830
     2 ,IKEY,IFRN                                                       00000840
C                                                                       00000850
      COMMON /PKMCOM/ XISPJ,DVINJ,DECPKM,RAPKM,TERRJ,SIGBJ(2),          00000860
     * DELNOJ,AINSYJ,ASJ,TAM,LEGJ,IGUIDJ,ITO,JPKM                       00000870
      COMMON /GEO/ AINSYI,AINTRI,AIS,ALAMDI,ANOM,AP,AS,ASM,             00000880
     1 DELNOI,DRTOL,DSMA,DVINI,DVNI,                                    00000890
     2EL(6),ES,ESM,SDAY,SNODE,STAFI,TCOV,TAMAN,                         00000900
     3 TERR,TUB,WAH,XB(6),XISPH,XISPI,DIS,FIS,DNS,FNS,ALI,ALF,ALD,      00000910
     4 IGUIDI,IOP,IW,LEG,IFLAG,ITOPT,ISCFLG,SCNPAR(3,5)                 00000920
        COMMON/TSCAN/WAPKM,TAKMAN,AKMWT,ISCANT(50),IUP,ISCAN(5)         00000930
      COMMON/SCNTY/TITLE(16),VAR(5)                                     00000940
      COMMON/LUS/LU8,LU9,LU16,LU20,LU21,LU25                            00000950
      COMMON/CVPR/ DTBI,DTCI,WCI,RA,DEC,THRI(100),WWCI(100),NBURN,      00000960
     1 ICVOUT                                                           00000970
      COMMON/MANINP/AMAN(6),VREOR,AKMIN                                 00000980
       COMMON/NOPRNT/NMLIST                                             00000990
      DIMENSION XCN(6),C1(25),ELT(25),GELT(25),TELT2(12)                00001000
      DIMENSION DVK(3),UDVK(3)                                          00001001
      DIMENSION EN(6),EVN(6,6),A(25),XI(6),TELT(12),E(6),EV(6,6)        00001010
      DIMENSION C2(25),C3(6),C4(6),T50(6,3),TV(3),XC(6),SIGB(3),AZ(6)   00001020
      DIMENSION HDRFT(3),C5(3),   UNSYN(3)                              00001030
      DIMENSION DUM(6)                                                  00001040
       DATA DUM/6*0.D0/                                                 00001050
       DIMENSION UDV(3),ZU(3),XU(3),YU(3),C(25),B(50),ELH(50),GELH(25)  00001060
      DIMENSION XS(6),DVC(3),XII(6),HP(3),HT(3)                         00001070
      DATA TELT/5HDV(I),5HDV(N),6HDV(IN),6HDV(IE),6HDV(IA),6HDV(NA),    00001080
     1 7HDV(INA),7HDV(IEA),7HDV(NEA),8HDV(INAE),6HDV(NE),7HDV(INE)/     00001090
      IF(K.NE.0) GO TO 1003                                             00001100
C  THE COMMANDS FOLLOWING THIS COMMENT UP TO AND INCLUDING              00001110
C  STATEMENT NO. 1003 ARE PERFORMED THE FIRST TIME GEOSX IS             00001120
C  CALLED.  THESE STATEMENTS INVOLVE INITIALIZATION AND THE             00001130
C  PRINTING OUT OF INITIAL VALUES OF VARIABLES, PRIMARILY.              00001140
C                                                                       00001150
      TERRA=TERR                                                        00001160
C  THIS WRITE STATEMENT PRINTS OUT THE FIRST MANEUVER INPUT DATA        00001170
      WRITE(6,490) XISPJ,DVINJ,DECPKM,RAPKM, TERRJ,SIGBJ,DELNOJ,        00001190
     * AINSYJ,ASJ,TAM,LEGJ,IGUIDJ,ITO,JPKM                              00001200
  490 FORMAT(1H0,45X,'FIRST MANEUVER INPUT',//,                         00001210
     * T6,'XISPJ    =',D16.8,T36,'DVINJ    =',D16.8,                    00001220
     * T66,'DECPKM   =',D16.8,T96,'RAPKM    =',D16.8,/,                 00001230
     * T6,'TERRJ    =',D16.8,T36,'SIGBJ(1) =',D16.8,                    00001240
     * T66,'SIGBJ(2) =',D16.8,T96,'DELNOJ   =',D16.8,/,                 00001250
     * T6,'AINSYJ   =',D16.8,T36,'ASJ      =',D16.8,                    00001260
     * T66,'TAM      =',D16.8,T96,'LEGJ     =',I3,/,                    00001270
     * T6,'IGUIDJ   =',I3,T36,'ITO      =',I3,                          00001280
     * T66,'JPKM     =',I3,///)                                         00001290
C  THE NEXT TWO WRITE STATEMENTS PRINT OUT THE GEOSYNCHRONOUS           00001300
C  OPTION INPUT DATA                                                    00001310
      WRITE(6,500) IGUIDI,ITOPT,LEG,IFLAG,XISPH,XISPI,DVINI,            00001320
     1WAH,PITCHI,YAWI,TERR,WI,THRUSI,(SIGBI(I),I=1,3)                   00001330
      WRITE(6,501)DVNI,DELNOI,TAMAN ,AINSYI,AS,                         00001340
     *ASM,ES,ESM,AIS,DRTOL,ALAMDI,AP,STAFI,TUB                          00001350
     *,DIS,FIS,DNS,FNS,ALI,ALF,ALD,ISCFLG                               00001360
  500 FORMAT(1H0,45X,'GEOSYNCHRONOUS OPTION INPUTS',/,5X,               00001370
     1'IGUIDI =',I3,19X,'ITOPT    =',I3,19X,'LEG      =',I3,            00001380
     A  19X,'IFLAG    =',I3,                                            00001390
     2/,5X,'XISPH  =',D20.12,2X,'XISPI    =',D20.12,2X,                 00001400
     3'DVINI    =',D20.12,2X,'WAH      =',D20.12,/,                     00001410
     45X,'PITCHI =',D20.12,2X,'YAWI     =',D20.12,2X,                   00001420
     5'TERR     =',D20.12,2X,'WI       =',D20.12,/,                     00001430
     65X,'THRUSI =',D20.12,2X,'SIGBI(1) =',D20.12,2X,                   00001440
     7'SIGBI(2) =',D20.12,2X,'SIGBI(3) =',D20.12)                       00001450
C                                                                       00001460
  501 FORMAT(5X,'DVNI   =',D20.12,2X,'DELNOI   =',D20.12,2X,            00001470
     8'TAMAN    =',D20.12,2X,'AINSYI   =',D20.12,/,5X,                  00001480
     9'AS     =',D20.12,2X,'ASM      =',D20.12,2X,                      00001490
     *'ES       =',D20.12,2X,'ESM      =',D20.12,/,5X,                  00001500
     4'AIS    =',D20.12,2X,'DRTOL    =',D20.12,2X,                      00001510
     2'ALAMDI   =',D20.12,2X,'AP       =',D20.12,/,5X,                  00001520
     3'STAFI  =',D20.12,2X,'TUB      =',D20.12,2X,                      00001530
     4'DIS      =',D20.12,2X,'FIS      =',D20.12,/,5X,                  00001540
     5'DNS    =',D20.12,2X,'FNS      =',D20.12,2X,                      00001550
     6'ALI      =',D20.12,2X,'ALF      =',D20.12,/,5X,                  00001560
     7'ALD    =',D20.12,2X,'ISCFLG   =',I3,/)                           00001570
      DATA GELT /3HECC,3HSMA,3HINC,5HOMEGA,4HARGP,5HTHETA,3HPER,4HAPOG, 00001580
     1 4HDELV,6HDV(AE),6HDV(IN),5HDRIFT,4HWTSA,6HHYDTOT,6HDVDRFT,       00001590
     25HHYDAE, 5HDVINC, 6HRA ABM,6HDECABM ,6HDPLANE,                    00001600
     47HXCOMANG,7HYCOMANG,5HDVCMB,6HHYDCMB,6HECCSYN/                    00001610
      DATA GELT2/7HNO CORR/                                             00001620
      DATA GELH/ 'E','A','I','NODE','AOP','TA','RP','RA','RAPKM',       00001630
     * 'DECPKM','PCH','HX','HY',12*'XXXX'/                              00001640
      DATA XXX/1.0D0/                                                   00001650
C                                                                       00001660
      DO 15 I=1,25                                                      00001680
      C(I) = 0.0D0                                                      00001690
   15 ELT(I)=GELT(I)                                                    00001700
C                                                                       00001710
      AII=AIS/57.29577951D0                                             00001730
      XISP=XISPI                                                        00001740
      DTC=DTCI                                                          00001750
      DTB=DTBI                                                          00001760
      ITI=0                                                             00001770
      IGUID=IGUIDI                                                      00001780
      DVN=DVNI                                                          00001790
      IF(IGUIDI.LT.3) FPA=0.D0                                          00001800
      W=WI                                                              00001810
      WIGN=WI                                                           00001820
      PITCH=PITCHI                                                      00001830
      YAW=YAWI                                                          00001840
      THRUST=THRUSI                                                     00001850
      SIGB(1)=SIGBI(1)                                                  00001860
      SIGB(2)=SIGBI(2)                                                  00001870
      SIGB(3)=SIGBI(3)                                                  00001880
      ALAMD=ALAMDI                                                      00001890
      AINTR=AINTRI                                                      00001900
      IF(TAMAN.NE.0.0D0)TAMANI=TAMAN                                    00001910
      AINSY=AINSYI                                                      00001920
      DELNO=DELNOI                                                      00001930
      DVIN=DVINI                                                        00001940
C  CONVERT FUEL INPUT TO DELTAV                                         00001950
      IF(DVINI.LT.0.D0)DVIN=G0*XISP*DLOG(W/(W+DVIN))                    00001960
      ITEE=0                                                            00001970
      IF(AIS.GE.0.D0) ITEE=ITEE+1                                       00001980
      IF(DVN.GE.0.D0) ITEE=ITEE+2                                       00001990
      IF(ESM.GE.0.D0) ITEE=ITEE+3                                       00002000
      IF(ASM.GE.0.D0) ITEE=ITEE+4                                       00002010
      IF(ITEE.EQ.5.AND.DVN.GE.0.D0) GO TO 1001                          00002020
      IF(ITEE.EQ.6.AND.AIS.GE.0.D0) GO TO 1002                          00002030
      ELT(11)=TELT(ITEE)                                                00002040
      IF(ITEE.EQ.0)ELT(11)=GELT2                                        00002050
C                                                                       00002070
      GO TO 1003                                                        00002080
 1001 ELT(11)=TELT(11)                                                  00002090
C                                                                       00002100
      GO TO 1003                                                        00002110
 1002 ELT(11)=TELT(12)                                                  00002120
C                                                                       00002130
 1003 CONTINUE                                                          00002140
C  PARKING ORBIT CALCULATIONS BEGIN                                     00002150
      DO 200 I=1,6                                                      00002160
  200 XII(I) = XIS(I)                                                   00002170
      IF(K.NE.0)GOTO 225                                                00002180
C  CONVERT INITIAL ORBIT CARTESIAN COMPONENTS TO KEPLERIAN              00002190
      CALL ORB(XIS,XIS(4),XMU,C2)                                       00002200
C  C2 CONTAINS THE KEPLERIAN ELEMENTS OF THE INTIAL ORBIT               00002210
C  MANEUVER COUNTER                                                     00002220
      MN=0                                                              00002230
      RXX=FNORM(XIS)                                                    00002240
      VXX=FNORM(XIS(4))                                                 00002250
      PERIOD=2*XPI*DSQRT(C2(2)**3/XMU)                                  00002260
      DRIFT=TCOV*(PERIOD-SDAY)/PERIOD                                   00002270
      A(8)=C2(2)*(1.D0+C2(1))                                           00002310
      A(7)=C2(2)*(1.D0-C2(1))                                           00002320
C  OUTPUT PRINTS OUT INITIAL ORBIT DATA ON OUTPUT DATA SET FT25         00002330
      CALL OUTPUT(LU25,LEGJ,LEG,XIS,DUM,C2   ,DUM ,RXX,VXX,DUM,DUM,     00002340
     .MN,DUM ,DUM ,PERIOD,DRIFT,A(8),A(7))                              00002350
  225 RAS = RAPKM                                                       00002360
      DEC = DECPKM                                                      00002370
C  TRANSFER ORBIT CALCULATIONS BEGIN                                    00002380
      IF(JPKM.EQ.1) MN=2                                                00002390
      IF(JPKM .EQ. 1) GO TO 275                                         00002400
C  PREP IS CALLED TO PERFORM A PKM MANEUVER                             00002410
      CALL PREP(XIS,XIS(4),XXX,XISPJ,XXX,W,XND,AINSYJ,DELNOJ,           00002420
     * DECPKM,RAPKM,DTC,DTB,WC,XS,XS(4),XMU,DV,DEC,RAS,LEGJ,K,          00002430
     * DVINJ,IGUIDJ,ASJ,TERRJ,ITO,ALPHA,BETA,NCONF,XXX,XXX,XXX,         00002440
     * FPA,TAM,DVC,SIGBJ,IKEY,IFRN)                                     00002450
      DO 250 I=1,3                                                      00002460
  250 XII(I) = XS(I)                                                    00002470
      XII(4) = XS(4) + DVC(1)                                           00002480
      XII(5) = XS(5) + DVC(2)                                           00002490
      XII(6) = XS(6) + DVC(3)                                           00002500
      MN=1                                                              00002510
  275 CONTINUE                                                          00002520
C  ORB CONVERTS CARTESIAN ELEMENTS (XII) TO KEPLERIAN ELEMENTS (C2)     00002530
      CALL ORB(XII,XII(4),XMU,C2)                                       00002540
      DO 300 I=1,6                                                      00002550
  300 C(I) = C2(I)                                                      00002560
C  C(7) AND C(8) ARE THE RADII OF PERIGEE AND APOGEE, RESPECTIVELY      00002570
      C(7) = C(2)*(1.0-C(1))                                            00002580
      C(8) = C(2)*(1.0+C(1))                                            00002590
      C(9) = RAS                                                        00002600
      C(10) = DEC                                                       00002610
C  HP & HT ARE SPECIFIC ANGULAR MOMENTUM VECTORS OF THE PARKING AND     00002620
C  TRANSFER ORBITS, RESPECTIVELY.                                       00002630
      CALL UCROSS(XIS(1),XIS(4),HP)                                     00002640
      CALL UCROSS(XII(1),XII(4),HT)                                     00002650
      CPCH = DOT(HP,HT)                                                 00002660
      IF(CPCH .GT. 1.0D0) CPCH=1.0D0                                    00002670
      IF(CPCH .LT. (-1.0D0)) CPCH=-1.0D0                                00002680
      PCH = DARCOS(CPCH)*R2D                                            00002690
      C(11) = PCH                                                       00002700
      C(12) = HT(1)                                                     00002710
      C(13) = HT(2)                                                     00002720
      DO 18 I=1,6                                                       00002730
      XI(I)=XII(I)                                                      00002740
      XC(I)=XII(I)                                                      00002750
      XB(I)=XII(I)                                                      00002760
      C4(I)=0.D0                                                        00002770
   18 CONTINUE                                                          00002780
      IF(K .NE. 0) GO TO 100                                            00002790
C  THE COMMANDS FOLLOWING THIS COMMENT UP TO AND INCLUDING STATEMENT    00002800
C  NUMBER 100 ARE PERFORMED THE FIRST TIME THROUGH GEOSX, ONLY.  THESE  00002810
C  STATEMENTS INVOLVE MATRIX CALCULATIONS AND THE PRINTING OUT OF       00002820
C  TRANSFER ORBIT DATA, PRIMARILY.                                      00002830
C  SUBROUTINE CONVET DETERMINES THE TRANSFORMATION MATRIX FROM THE      00002840
C  LOCAL TANGENT TO THE EQUATORIAL SYSTEM.                              00002850
      IF(IP1COR.EQ.1.OR.IP1COR.EQ.3) CALL CONVET(P1I,XI,XI(4),2,P1I)    00002860
      IF(IP2COR.EQ.1.OR.IP2COR.EQ.3) CALL CONVET(P2I,XI,XI(4),2,P2I)    00002870
      WRITE (6,650)                                                     00002880
  650 FORMAT(//,25X,'BEFORE COAST',//)                                  00002890
C  MTXPR FINDS THE CORRELATION EIGENVALUES AND MATRIX FOR A             00002900
C  COVARIANCE MATRIX                                                    00002910
      IF(NCONF .GT. 2 .AND. IP1COR .GT. 0) CALL MTXPR(XI,P1I,E,EV,XMU)  00002920
      WRITE(6,651)                                                      00002930
  651 FORMAT(//25X,'O-D ERRORS'//)                                      00002940
      IF(NCONF .GT. 2 .AND. IP2COR .GT. 0) CALL MTXPR(XI,P2I,EN,EVN,XMU)00002950
      RXX=FNORM(XI)                                                     00002960
      VXX=FNORM(XI(4))                                                  00002970
      WRITE(6,692) RXX,VXX                                              00002980
      WRITE(6,700) (NAMES(I),I=1,6),(C2(I),I=1,6)                       00002990
      PEROD=SDAY*(ALAMD/(TCOV-ALAMD)+1.D0)                              00003000
      PERO=2*XPI*DSQRT(C(2)**3/XMU)                                     00003010
      DSMA=DEXP(DLOG(XMU*PEROD**2/(4.D0*P1**2))/3.D0)                   00003020
      AI=C2(3)/R2D                                                      00003030
      APF=C2(5)/R2D                                                     00003040
      AN=C2(4)/R2D                                                      00003050
      ANS=AN+DELNO/R2D                                                  00003060
      SNODE=ANS                                                         00003070
      IF(MN.EQ.2.OR.K.NE.0) GOTO 100                                    00003080
C  DRIFT=DRIFT RATE                                                     00003090
       DRIFT=TCOV*(PERO-SDAY)/PERO                                      00003100
C  OUTPUT PRINTS OUT THE TRANSFER ORBIT DATA ON OUTPUT DATA SET FT25    00003110
      CALL OUTPUT (LU25,LEGJ,LEG,XII,DUM ,C,DUM ,RXX,VXX,DV,DVC,        00003120
     .MN,RAS,DEC,PERO,DRIFT,C(8),C(7))                                  00003130
  100 CONTINUE                                                          00003140
      IF(NCONF.NE.1) GO TO 761                                          00003150
C  CONVERT CARTESIAN TO KEPLERIAN ELEMENTS                              00003160
      CALL ORB(XII,XII(4),XMU,C2)                                       00003170
      AII=AINSY*D2R                                                     00003180
      AIS=DABS(AIS)                                                     00003190
      DO 761 I=1,6                                                      00003200
      XI(I)=XII(I)                                                      00003210
      XC(I)=XII(I)                                                      00003220
      XB(I)=XII(I)                                                      00003230
      C4(I)=0.D0                                                        00003240
  761 CONTINUE                                                          00003250
      IF (K.EQ.0) GO TO 522                                             00003260
C  THE STATEMENTS UP TO STATEMENT NO. 522 ARE NOT DONE WHEN NOMINAL     00003270
C  ORBIT COMPUTATIONS ARE BEING DONE.  RANDOM CAUSES A RANDOM ERROR TO  00003280
C  BE GENERATED WHICH IS ADDED TO THE STATE VECTOR TO PRODUCE A STATE   00003290
C  VECTOR WITH ERRORS.                                                  00003300
      IF(IP1COR .GT. 0) CALL RANDOM(EV,E,XB,XC,IKEY,IFRN)               00003310
C  CALCULATE ORBITAL PARAMETERS FOR TRANSFER ORBIT, IF USING            00003320
C  COVARIANCE MATRIX FOR PARKING TO TRANSFER ORBIT MANEUVER             00003330
      IF(JPKM.EQ.0.OR.K.EQ.0) GO TO 801                                 00003340
      CALL ORB(XC,XC(4),XMU,AZ)                                         00003350
      CALL UCROSS(XC(1),XC(4),HT)                                       00003360
      DO 802 IJ=1,3                                                     00003370
 802  DVK(IJ)=XC(IJ+3)-XB(IJ+3)                                         00003380
      DVK2=FNORM(DVK)                                                   00003390
      DO 803 IK=1,3                                                     00003400
 803   UDVK(IK)=DVK(IK)/DVK2                                            00003410
       CALL SARA(UDVK,RAS,DEC,1)                                        00003420
       C(9)=RAS                                                         00003430
       C(10)=DEC                                                        00003440
       DO 805 ICH=1,6                                                   00003450
 805   C(ICH)=AZ(ICH)                                                   00003460
       C(7)=C(2)*(1.0-C(1))                                             00003470
       C(8)=C(2)*(1.0+C(1))                                             00003480
       CPCH=DOT(HP,HT)                                                  00003490
       IF(CPCH.GT.1.D0) CPCH=1.D0                                       00003500
       IF(CPCH.LT.-1.D0) CPCH=-1.D0                                     00003510
       PCH=DARCOS(CPCH)*R2D                                             00003520
       C(11)=PCH                                                        00003530
       C(12)=HT(1)                                                      00003540
       C(13)=HT(2)                                                      00003550
 801   CONTINUE                                                         00003551
C  END OF CALCULATIONS FOR COVARIANCE MATRIX                            00003560
      IF(IFLAG.NE.0) GO TO 553                                          00003570
      IF(IP2COR .LT. 0 .OR. P2I(1,1) .EQ. 0.D0) GO TO 521               00003580
C  SAMPLE NAV. COV. MATRIX                                              00003590
      IF(IP2COR .GT. 0) CALL RANDOM(EVN,EN,XC,XCN,IKEY,IFRN)            00003600
  522 IF(K.GT.0) GO TO 524                                              00003610
  521 DO 523 I=1,6                                                      00003620
      XCN(I)=XC(I)                                                      00003630
  523 CONTINUE                                                          00003640
  524 CONTINUE                                                          00003650
C  DRIFT ORBIT CALCULATIONS BEGIN                                       00003660
      IF(IFLAG.NE.0) GO TO 553                                          00003670
C  PREP IS CALLED TO PERFORM AN AKM MANEUVER                            00003680
      CALL PREP(XCN,XCN(4),ALAMD,XISP,THRUST,W,SNODE,AINSY,DELNO,PITCHI,00003690
     .YAWI,DTC,DTB,WC,C3,C3(4),XMU,DV,PITCH,YAW,LEG,K,DVIN,IGUID,DSMA,  00003700
     .TERR,ITOPT,ALPHA,BETA,NCONF,ALI,ALF,ALD,FPA,TAMAN,C4,SIGBI,       00003710
     *  IKEY,IFRN)                                                      00003720
      ALPHAD=ALPHA*R2D                                                  00003730
      BETAD =BETA*R2D                                                   00003740
      SNOD=SNODE*R2D                                                    00003750
      IF(SNOD.LT.0.D0) SNOD=SNOD + 360.D0                               00003760
      IF(P2I(1,1).EQ.0.D0) GO TO 535                                    00003770
      ND=1                                                              00003780
      CALL STEPD(ND,DTC,TA,XC,XC(4),XMU,C3,C3(4),1,C1)                  00003790
  535 CONTINUE                                                          00003800
      DO 537 I = 1,6                                                    00003810
      XC(I) = C3(I)                                                     00003820
      IF (I.GE.4) XC(I) = C3(I)+C4(I-3)                                 00003830
  537 CONTINUE                                                          00003840
C  COMPUTE RA AND DEC OF VELOCITY VECTOR IN SYNCHRONOUS ORBIT           00003850
      CALL VNORM(C4,C5)                                                 00003860
      CALL SARA(C5(1),RASYN,DECSYN,1)                                   00003870
      RASYN = RASYN*R2D                                                 00003880
      DECSYN = DECSYN*R2D                                               00003890
      IF(ITI.GT.0)GO TO 553                                             00003900
      IF (K.GT.0) GO TO 553                                             00003910
      WRITE (6,691) DTC,DTB,WC,DV,PITCH,YAW                             00003920
C  WIGN=WEIGHT AFTER THE AKM BURN                                       00003930
      WIGN=WI + WC - WAH                                                00003940
      WRITE(6,902) WIGN                                                 00003950
  902 FORMAT( /,'  WEIGHT AFTER ABM BURN,        M1=',E15.8, /)         00003960
      DVIN=DV*XKM2F                                                     00003970
      RXX = FNORM(C3)                                                   00003980
      VXX = FNORM(C3(4))                                                00003990
      VYY = FNORM(XC(4))                                                00004000
      WRITE (6,693) RXX,VXX,VYY,C3,XC                                   00004010
  553 CONTINUE                                                          00004020
C  COMPUTE PLANE CHANGE BETWEEN DRIFT AND SYNCHRONOUS ORBITS            00004030
       IF(IFLAG.EQ.0) GOTO 554                                          00004040
       DO 201 I=1,6                                                     00004050
       C3(I)=C2(I)                                                      00004060
       XC(I)=XII(I)                                                     00004070
  201  CONTINUE                                                         00004080
  554  CONTINUE                                                         00004090
      CALL UCROSS(C3(1),C3(4),HDRFT)                                    00004100
      CALL UCROSS(XC(1),XC(4),UNSYN)                                    00004110
      CDP=DOT(HDRFT,UNSYN)                                              00004120
      IF(CDP .GT. 1.0D0) CDP=1.0D0                                      00004130
      IF(CDP .LT. (-1.0D0)) CDP=-1.0D0                                  00004140
      DPLANE = DARCOS(CDP)*R2D                                          00004150
C  AZ=KEPLERIAN ELEMENTS BEFORE AKM MANEUVER; A=KEPLERIAN ELEMENTS      00004160
C  AFTER AKM MANEUVER                                                   00004170
      CALL ORB(XC,XC(4),XMU,A)                                          00004180
       CALL ORB(C3,C3(4),XMU,AZ)                                        00004190
      AI=A(3)/R2D                                                       00004200
      APF=A(5)/R2D                                                      00004210
      AN=A(4)/R2D                                                       00004220
      DMM=(DSQRT(XMU/A(2))/A(2))                                        00004230
C  DPER=PERIOD OF SATELLITE IN DRIFT ORBIT, FROM KEPLER'S 3RD LAW       00004240
      DPER=2.D0*P1/DMM                                                  00004250
      DRIFT=TCOV*(DPER-SDAY)/DPER                                       00004260
      A(8)=A(2) * (1.D0+A(1))                                           00004270
      A(7) = A(2)*(1.D0-A(1))                                           00004280
      A(9) = 0.D0                                                       00004290
      A(10)=0.D0                                                        00004300
      A(11)=0.D0                                                        00004310
      A(12)=0.D0                                                        00004320
      DDRIFT=ALAMD                                                      00004330
      SAVERA=A(8)                                                       00004340
      SAVERP=A(7)                                                       00004350
      SAVEA=A(2)                                                        00004360
      SAVEE=A(1)                                                        00004370
      IF(TAMAN.GT.0.0D0)AII=AI                                          00004380
C  DRFTDV COMPUTES THE DELTA-V REQUIRED TO ACHIEVE THE DESIRED DRIFT    00004390
C  RATE.  A(15) WILL CONTAIN THIS DELTA-V VALUE.                        00004400
      CALL DRFTDV(A,DDRIFT,DRIFT,DRTOL, DSMA,STAFI,AP,TUB,K)            00004410
      TEMP = 3280.84D0/XISPH/32.174D0                                   00004420
      A(15) = A(9)                                                      00004430
      A(16)=-WIGN*(DEXP(-1.D0 *  A(10)*TEMP) - 1.D0)                    00004440
      A(8)=A(2)*(1.D0+A(1))                                             00004450
      A(7)=A(2)*(1.D0-A(1))                                             00004460
C  DRIFT ORBIT OUTPUT                                                   00004470
      MN=2                                                              00004480
      IF(NMLIST.EQ.0) GO TO 119                                         00004490
C  IF(IFLAG.NE.0.OR.K.NE.0)GOTO 119                                     00004500
      DVI=DVIN/XKM2F                                                    00004510
C  OUTPUT PRINTS THE DRIFT ORBIT DATA ON OUTPUT DATA SET FT25           00004520
      CALL OUTPUT(LU25,LEGJ,LEG,C3,AZ,A,XC,RXX,VXX,DVI ,C4,MN,          00004530
     .RASYN,DECSYN,DPER,DRIFT,A(8),A(7))                                00004540
C  SYNCHRONOUS ORBIT CALCULATIONS BEGIN                                 00004550
  119  MN=3                                                             00004560
C  DELVS IS A SUBDRIVER THAT ACTIVATES SUBROUTINES AEIN, PA, AND AP TO  00004611
C  CALCULATE DRIFT ORBIT TO SYNCHRONOUS ORBIT MANEUVERS.  A(11)=OUT OF  00004612
C  PLANE DELTA-V, A(10)=INPLANE DELTA-V, & A(9)=TOTAL DELTA-V REQUIRED. 00004613
       A(17)=0.D0                                                       00004620
       DUM1=0.                                                          00004630
       DUM2=0.                                                          00004640
 120  CALL DELVS(A(2),A(8),A(7),AS, ES,VREOR,AI,AII,AN,SNODE,XMU,A(9),  00004650
     2 DVN,APF,ASM,ESM,A(10),A(11),AMAN)                                00004660
      A(20)=DPLANE                                                      00004670
      A(21)=UNSYN(1)                                                    00004680
      A(22)=UNSYN(2)                                                    00004690
C  THE NEXT SEVEN STATEMENTS ENABLE DELVS TO BE USED TO CALCULATE A(17) 00004700
C  THE DELTA-V REQUIREMENT IF ONLY AN INCLINATION CHANGE IS DESIRED.    00004710
C  AMAN(1)=4 AND THE -1.D0 INPUT IN DELVS ENABLE A(17) TO BE FOUND.     00004720
      AMNO1=AMAN(1)                                                     00004730
      AMNO2=AMAN(2)                                                     00004740
      AMAN(1)=4.D0                                                      00004750
      AMAN(2)=0.D0                                                      00004760
      CALL DELVS(A(2),A(8),A(7),AS, ES,VREOR,AI,AII,AN,SNODE,XMU,DUM1,  00004770
     2 -1.D0,APF,ASM,ESM,DUM2,A(17),AMAN)                               00004780
      AMAN(1)=AMNO1                                                     00004790
      AMAN(2)=AMNO2                                                     00004800
      A(23)=DSQRT(A(10)*A(10)+A(11)*A(11))                              00004810
      A(18)=RASYN                                                       00004820
      A(19)=DECSYN                                                      00004830
      A(24)=-WIGN*(DEXP(-1.D0 * A(23) * TEMP) - 1.D0)                   00004840
C  SYNCHRONOUS ECCENTRICITY A(25)                                       00004850
      A(25)=ES                                                          00004860
  147 CONTINUE                                                          00004870
C                                                                       00004890
      A(01)=SAVEE                                                       00004900
      A(02)=SAVEA                                                       00004910
      A(12)=DRIFT                                                       00004920
      A(08)=SAVERA                                                      00004930
      A(07)=SAVERP                                                      00004940
      TEMP=A(9)*XKM2F/XISPH/G0                                          00004950
      A(13)=WIGN*DEXP(-1.D0*TEMP)                                       00004960
      A(14)=WIGN-A(13)                                                  00004970
      IF(NCONF.NE.1)GO TO 730                                           00004980
      A10=A(10)*1000.D0                                                 00004990
      A11=A(11)*1000.D0                                                 00005000
      A9 =A(9)*1000.D0                                                  00005010
      A15=A(15)*1000.D0                                                 00005020
C  THE TAMAN VALUE DETERMINES WHICH SET OF OUTPUT PARAMETERS ARE        00005030
C  PRINTED IN THE SCAN LOGIC.  IN SPECIFIC, THE DEFINITIONS OF XOPT     00005040
C  THROUGH QOPTD ARE DIFFERENT DEPENDING ON WHETHER TAMAN=0 OR NOT      00005050
      IF(TAMAN .NE. 0.0) GO TO 705                                      00005060
      IF(ITI.LE.1) WRITE(6,731)                                         00005070
      XOPT = SNOD                                                       00005080
      YOPT = AINSY                                                      00005090
      POPT=FPA                                                          00005100
      QOPT=AII                                                          00005110
      POPTD=FPA                                                         00005120
      QOPTD=AII*R2D                                                     00005130
      GOTO 708                                                          00005140
  705 IF(ITI .LE. 1) WRITE(6,734)                                       00005150
      XOPT = DELNO                                                      00005160
      YOPT = TAMAN                                                      00005170
      POPT=AI                                                           00005180
      QOPT=AN                                                           00005190
      POPTD=AI*R2D                                                      00005200
      QOPTD=AN*R2D                                                      00005210
 708  WRITE(6,732) XOPT,YOPT,ALPHAD,BETAD,POPTD,A(5),A(1),A(25),A(12),  00005220
     .A10,QOPTD,A15,A9,A(14)                                            00005230
      IF(LU9 .GT. 0) WRITE(LU9)XOPT,YOPT,ALPHAD,BETAD,POPTD,            00005240
     *A(5),A(1),A(25),A(12),A10,QOPTD,A15,A9,A(14)                      00005250
      IF(ITI.EQ.0) ITI=2                                                00005260
      IF(ITI.GT.50)ITI=0                                                00005270
      ITI=ITI+1                                                         00005280
      IF(TAMAN.NE.0.0)TAMAN=TAMAN+DIS                                   00005290
      IF(TAMAN.EQ.0.0)AINSY=AINSY+DIS                                   00005300
      IF(AINSY.GT.FIS.AND.TAMAN.EQ.0.0D0)GOTO710                        00005310
      IF(TAMAN.GT.FIS.AND.TAMAN.NE.0.0D0)GOTO710                        00005320
      GO TO 100                                                         00005330
  710 DELNO=DELNO+DNS                                                   00005340
      IF(TAMAN.NE.0.0D0)GOTO715                                         00005350
      IF(SNOD.GT.FNS.AND.DNS.GT.0.D0) GO TO 730                         00005360
      IF(SNOD.LT.FNS.AND.DNS.LT.0.D0) GO TO 730                         00005370
      AINSY=AINSYI                                                      00005380
      WRITE(6,733)                                                      00005390
      GO TO 100                                                         00005400
 715  IF(DELNO.GT.FNS.AND.DNS.GT.0.0D0)GOTO730                          00005410
      IF(DELNO.LT.FNS.AND.DNS.LT.0.0D0)GOTO730                          00005420
      TAMAN=TAMANI                                                      00005430
      WRITE(6,734)                                                      00005440
      GOTO100                                                           00005450
  730 CONTINUE                                                          00005460
      IF(NCONF.EQ.1 .AND. LU9 .GT. 0) ENDFILE LU9                       00005470
  691 FORMAT(/13X,'DTC',18X,'DTB',19X,'WC',19X,'DV',16X,'PITCH',18X,    00005480
     1  'YAW'/6D21.13)                                                  00005490
  693 FORMAT(/9X,'R COAST',14X,'V COAST',15X,'V BURN'/3D21.13//5X,      00005500
     1 'STATE AFTER COAST'/6D21.13//5X,'STATE AFTER BURN'/6D21.13)      00005510
  692 FORMAT(/15X,'R',18X,'V',/2D21.13)                                 00005520
  700 FORMAT(/5X,24HORBITAL ELEMENTS NOMINAL/6(13X,A8)/6D21.13)         00005530
  731 FORMAT('1',//,3X,'FNODE',5X,'INC',6X,'RA',7X,'DEC',               00005540
     1 6X,'FPA',5X,'AOP',5X,'ECC',4X,'ECCSYN',2X,'DRIFT+W',4X,          00005550
     2 'DV-AE',4X,'I-SYN',3X,'DV-DRFT',4X,'DVTOT',4X,'WT-HYD',/,        00005560
     3 3X,'(DEG)',4(4X,'(DEG)'),3X,'(DEG)',3X,'(N/A)',3X,'(N/A)',       00005570
     4 3X,'(DEG/DY)',  2X,'(M/SEC)',2X,' (DEG) ',2X,'(M/SEC)',3X,       00005580
     5  '(M/SEC)',4X,'(LBS)'/)                                          00005590
  732 FORMAT(1X,F8.3,1X,F8.3,1X,F8.3,2X,F7.3,2X,F6.2,1X,F7.2,3X,        00005600
     1 F6.5,2X,F6.5,1X,F8.2,1X,F7.0,2(2X,F7.1),2(3X,F7.0))              00005610
  733 FORMAT(/)                                                         00005620
  734 FORMAT('1',//,4X,'DIHED',5X,'TA ',6X,'RA',7X,'DEC',               00005630
     1 6X,'INC',5X,'AOP',5X,'ECC',4X,'ECCSYN',3X,'DRIFT+W',4X,          00005640
     2 'DV-AE',4X,'NODE ',3X,'DV-DRFT',4X,'DVTOT',4X,'WT-HYD',/,        00005650
     3 4X,'(DEG)',4(4X,'(DEG)'),3X,'(DEG)',3X,'     ',3X,'     ',       00005660
     4 4X,'(DEG/DY)',3(2X,'(M/SEC)'),3X,'(M/SEC)',4X,'(LBS)'/)          00005670
      DO 800 I=1,25                                                     00005680
      B(I) = C(I)                                                       00005690
      B(I+25) = A(I)                                                    00005700
      ELH(I) = GELH(I)                                                  00005710
      ELH(I+25) = ELT(I)                                                00005720
  800 CONTINUE                                                          00005730
      RETURN                                                            00005740
      END                                                               00005750
C          DATA SET GEOSY      AT LEVEL 007 AS OF 04/09/79              00000010
C          DATA SET GEOSY      AT LEVEL 025 AS OF 01/26/79              00000020
C          DATA SET GEOS       AT LEVEL 019 AS OF 05/25/78              00000030
C          DATA SET GEOS       AT LEVEL 011 AS OF 05/02/78              00000040
      SUBROUTINE GEOSY                                                  00000050
C                                                                       00000060
C     SUBROUTINE GEOSY(B,K,ELH)                                         00000080
C                                                                       00000090
C     THE PURPOSE OF GEOS IS TO SIMULATE A GEOSYNCHRONOUS MISSION FROM  00000120
C         TRANSFER ORBIT INJECTION THROUGH STATION ACQUISITION.         00000130
C                                                                       00000140
C     ARGUMENTS IN THE FOLLOWING SEQUENCE ARE DEFINED AS FOLLOWS.       00000170
C                                                                       00000180
C        ARGUMENTS   TYPE    I/O        DEFINITION                      00000190
C         B(50)      R*8      O      ARRAY CONTAINING TRAJECTORY        00000210
C                                       PARAMETERS                      00000220
C         K          I*4      I      K=0, WRITE OUT THE GEOSYNCHRONOUS  00000230
C                                       MODE INPUTS,.AND INITIALIZE     00000240
C                                       INTERNAL PROGRAM VARIABLES WITH 00000250
C                                       INPUT VALUES K>0, SKIP THE WRITE00000260
C                                       AND INITIALIZATION STATEMENTS   00000270
C         ELH(50)    R*8      O      ARRAY CONTAINING OUTPUT TITLES     00000280
C                                       CORRESPONDING TO THE B ARRAY    00000290
C                                                                       00000310
C     GEOS IS CALLED BY THE FOLLOWING SUBROUTINES.                      00000330
C                                                                       00000340
C         MAIN                                                          00000350
C                                                                       00000360
C     THE FOLLOWING SUBROUTINES ARE CALLED BY GEOSY                     00000400
C                                                                       00000410
C      CONVET   DELVS  DRFTDV  DOT   MTXPR   ORB  PREP   RANDOM         00000420
C         SARA   SCOUT  STEPD   UCROSS                                  00000430
C                                                                       00000450
C     THE FOLLOWING FUNCTION SUBPROGRAMS ARE CALLED BY GEOSY            00000470
C                                                                       00000480
C         FNORM     VNORM                                               00000490
C                                                                       00000500
C     THE VARIABLES APPEARING IN COMMON BLOCKS ARE TABULATED BELOW.     00000530
C                                                                       00000540
C         COMMON VARIABLES USED                                         00000550
C                                                                       00000560
C         AINSY1    ASM       ESM       ISCFLAG   R2D       WA          00000570
C         AINTR1    DELNO1    FIS       ITOPT     SDAY      W1          00000580
C         AIS       DIS       GO        LEG       SIGB1(3)  X11         00000590
C         ALAMD1    DNS       IFLAG     LU9       STAF1     XISP1       00000600
C         ALD       DRTOL     IGUID1    NAMES     TAMAN     XISP4       00000610
C         ALF       DVIN1     IKEY      NCONF     TCOV      XKM2K       00000620
C         AL1       DVN1      IP1COR    P1        THRUS1    XMU         00000630
C         AP        D2R       IP2COR    PITCH1    TUB       YAW1        00000640
C         AS        ES                                                  00000650
C                                                                       00000660
C         COMMON VARIABLES USED AND COMPUTED                            00000670
C                                                                       00000680
C         DSMA      P11(6,6)  P21(6,6)  SNODE     TERR      XB(6)       00000690
C         IFRN                                                          00000700
C                                                                       00000730
      IMPLICIT REAL*8(A-H,O-Z)                                          00000740
      REAL*8  NAMES,ZU,ZM                                               00000750
      REAL*4 ZUB,ZDELT                                                  00000760
      COMMON /CONST/ S2LB,D2R,XPI,R2D,F2KM,XKM2F,G0                     00000770
      COMMON /GENRL/ P1,PI(6,6),XIS(6),XMU,NAMES(6),PITCHI,YAWI,WI,     00000780
     A P1I(6,6),P2I(6,6),P3I(6,6),P4I(6,6),P5I(6,6),P6I(6,6),TOLR(50),  00000790
     * THRUSI,SIGBI(3),ZDELT,ZUB(3,50),                                 00000800
     B IP1COR,IP2COR,IP3COR,IP4COR,IP5COR,IP6COR,                       00000810
     1 ICOV(50),IHIST(50),IPCOOR,ITPSTR,NCONF,MODE                      00000820
     2 ,IKEY,IFRN                                                       00000830
C                                                                       00000840
      COMMON /PKMCOM/ XISPJ,DVINJ,DECPKM,RAPKM,TERRJ,SIGBJ(2),          00000850
     * DELNOJ,AINSYJ,ASJ,TAM,LEGJ,IGUIDJ,ITO,JPKM                       00000860
      COMMON /GEO/ AINSYI,AINTRI,AIS,ALAMDI,ANOM,AP,AS,ASM,             00000870
     1 DELNOI,DRTOL,DSMA,DVINI,DVNI,                                    00000880
     2EL(6),ES,ESM,SDAY,SNODE,STAFI,TCOV,TAMAN,                         00000890
     3 TERR,TUB,WAH,XB(6),XISPH,XISPI,DIS,FIS,DNS,FNS,ALI,ALF,ALD,      00000900
     4 IGUIDI,IOP,IW,LEG,IFLAG,ITOPT,ISCFLG,SCNPAR(3,5)                 00000910
      COMMON/LUS/LU8,LU9,LU16,LU20,LU21,LU25                            00000920
      COMMON/TSCAN/WAPKM,TAKMAN,AKMWT,ISCANT(50),IUP,ISCAN(5)           00000930
       COMMON/SCNTY/TITLE(16),VAR(5)                                    00000940
      COMMON/CVPR/ DTBI,DTCI,WCI,RA,DEC,THRI(100),WWCI(100),NBURN,      00000950
     1 ICVOUT                                                           00000960
      COMMON/MANINP/AMAN(6),VREOR,AKMIN                                 00000970
      DIMENSION XCN(6),C1(25),ELT(25),GELT(25),TELT2(12)                00000980
      DIMENSION EN(6),EVN(6,6),A(25),XI(6),TELT(12),E(6),EV(6,6)        00000990
      DIMENSION C2(25),C3(6),C4(6),T50(6,3),TV(3),XC(6),SIGB(3)         00001000
      DIMENSION HDRFT(3),C5(3),   UNSYN(3)                              00001010
       DIMENSION UDV(3),ZU(3),XU(3),YU(3),C(25),B(50),ELH(50),GELH(25)  00001020
      DIMENSION XS(6),DVC(3),XII(6),HP(3),HT(3),ELHU(50)                00001030
      DATA TELT/5HDV(I),5HDV(N),6HDV(IN),6HDV(IE),6HDV(IA),6HDV(NA),    00001040
     1 7HDV(INA),7HDV(IEA),7HDV(NEA),8HDV(INAE),6HDV(NE),7HDV(INE)/     00001050
      DATA ELHU/'        ','  KM.   ','  DEG.  ','  DEG.  ','  DEG.  ', 00001060
     1          '  DEG.  ','  KM.   ','  KM.   ','  DEG.  ','  DEG.  ', 00001070
     2          '  DEG.  ','        ','        ','        ','        ', 00001080
     3          '        ','        ','        ','        ','        ', 00001090
     4          '        ','        ','        ','        ','        ', 00001100
     5          '        ','  KM.   ','  DEG.  ','  DEG.  ','  DEG.  ', 00001110
     6          '  DEG.  ','  KM.   ','  KM.   ','KM./SEC.','KM./SEC.', 00001120
     7          'KM./SEC.','DEG./DAY','  LBS.  ',' LBS.   ','KM./SEC.', 00001130
     8          '  LBS.  ','KM./SEC.','  DEG.  ','  DEG.  ','  DEG.  ', 00001140
     9          '        ','        ','KM./SEC.','  LBS.  ','        '/ 00001150
      K=0                                                               00001160
C                                                                       00001170
      TERRA=TERR                                                        00001180
      DATA GELT /3HECC,3HSMA,3HINC,5HOMEGA,4HARGP,5HTHETA,3HPER,4HAPOG, 00001190
     1 4HDELV,6HDV(AE),6HDV(IN),5HDRIFT,4HWTSA,6HHYDTOT,6HDVDRFT,       00001200
     25HHYDAE, 5HDVINC, 6HRA ABM,6HDECABM ,6HDPLANE,                    00001210
     47HXCOMANG,7HYCOMANG,5HDVCMB,6HHYDCMB,6HECCSYN/                    00001220
      DATA GELT2/7HNO CORR/                                             00001230
      DATA GELH/ 'E','A','I','NODE','AOP','TA','RP','RA','RAPKM',       00001240
     * 'DECPKM','PCH','HX','HY',12*'XXXX'/                              00001250
      DATA XXX/1.0D0/                                                   00001260
C                                                                       00001270
      DO 15 I=1,25                                                      00001280
      C(I) = 0.0D0                                                      00001290
   15 ELT(I)=GELT(I)                                                    00001300
C                                                                       00001310
      AII=AIS/57.29577951D0                                             00001330
      XISP=XISPI                                                        00001340
      DTC=DTCI                                                          00001350
      DTB=DTBI                                                          00001360
      ITI=0                                                             00001370
      IGUID=IGUIDI                                                      00001380
      DVN=DVNI                                                          00001390
      IF(IGUIDI.LT.3) FPA=0.D0                                          00001400
      W=WI                                                              00001410
      WIGN=WI                                                           00001420
      PITCH=PITCHI                                                      00001430
      YAW=YAWI                                                          00001440
      THRUST=THRUSI                                                     00001450
      SIGB(1)=SIGBI(1)                                                  00001460
      SIGB(2)=SIGBI(2)                                                  00001470
      SIGB(3)=SIGBI(3)                                                  00001480
      ALAMD=ALAMDI                                                      00001490
      AINTR=AINTRI                                                      00001500
      IF(TAMAN.NE.0.0D0)TAMANI=TAMAN                                    00001510
      AINSY=AINSYI                                                      00001520
      DELNO=DELNOI                                                      00001530
      DVIN=DVINI                                                        00001540
C  CONVERT FUEL INPUT TO DELTAV                                         00001550
      IF(DVINI.LT.0.D0)DVIN=G0*XISP*DLOG(W/(W+DVIN))                    00001560
      ITEE=0                                                            00001570
      IF(AIS.GE.0.D0) ITEE=ITEE+1                                       00001580
      IF(DVN.GE.0.D0) ITEE=ITEE+2                                       00001590
      IF(ESM.GE.0.D0) ITEE=ITEE+3                                       00001600
      IF(ASM.GE.0.D0) ITEE=ITEE+4                                       00001610
      IF(ITEE.EQ.5.AND.DVN.GE.0.D0) GO TO 1001                          00001620
      IF(ITEE.EQ.6.AND.AIS.GE.0.D0) GO TO 1002                          00001630
      ELT(11)=TELT(ITEE)                                                00001640
      IF(ITEE.EQ.0)ELT(11)=GELT2                                        00001650
C                                                                       00001660
      GO TO 1003                                                        00001680
 1001 ELT(11)=TELT(11)                                                  00001690
C                                                                       00001700
      GO TO 1003                                                        00001710
 1002 ELT(11)=TELT(12)                                                  00001720
C  TRANSFER ORBIT CALCULATIONS BEGIN                                    00001730
 1003 CONTINUE                                                          00001740
      DO 200 I=1,6                                                      00001750
  200 XII(I) = XIS(I)                                                   00001760
      RAS = RAPKM                                                       00001770
      DEC = DECPKM                                                      00001780
      IF(JPKM .EQ. 1) GO TO 275                                         00001790
C  PREP IS CALLED TO PERFORM A PKM MANEUVER                             00001800
      CALL PREP(XIS,XIS(4),XXX,XISPJ,XXX,W,XND,AINSYJ,DELNOJ,           00001810
     * DECPKM,RAPKM,DTC,DTB,WC,XS,XS(4),XMU,DV,DEC,RAS,LEGJ,K,          00001820
     * DVINJ,IGUIDJ,ASJ,TERRJ,ITO,ALPHA,BETA,NCONF,XXX,XXX,XXX,         00001830
     * FPA,TAM,DVC,SIGBJ,IKEY,IFRN)                                     00001840
      DO 250 I=1,3                                                      00001850
  250 XII(I) = XS(I)                                                    00001860
      XII(4) = XS(4) + DVC(1)                                           00001870
      XII(5) = XS(5) + DVC(2)                                           00001880
      XII(6) = XS(6) + DVC(3)                                           00001890
  275 CONTINUE                                                          00001900
C  ORB CONVERTS CARTESIAN (XII) TO KEPLERIAN (C2) ELEMENTS              00001910
      CALL ORB(XII,XII(4),XMU,C2)                                       00001920
      DO 300 I=1,6                                                      00001930
  300 C(I) = C2(I)                                                      00001940
C  C(7) & C(8) ARE THE RADII OF PERIGEE AND APOGEE, RESPECTIVELY        00001950
      C(7) = C(2)*(1.0-C(1))                                            00001960
      C(8) = C(2)*(1.0+C(1))                                            00001970
      C(9) = RAS                                                        00001980
      C(10) = DEC                                                       00001990
C  HP AND HT ARE THE SPECIFIC ANGULAR MOMENTA FOR THE PARKING AND       00002000
C  TRANSFER ORBITS, RESPECTIVELY                                        00002010
      CALL UCROSS(XIS(1),XIS(4),HP)                                     00002020
      CALL UCROSS(XII(1),XII(4),HT)                                     00002030
      CPCH = DOT(HP,HT)                                                 00002040
      IF(CPCH .GT. 1.0D0) CPCH=1.0D0                                    00002050
      IF(CPCH .LT. (-1.0D0)) CPCH=-1.0D0                                00002060
      PCH = DARCOS(CPCH)*R2D                                            00002070
      C(11) = PCH                                                       00002080
      C(12) = HT(1)                                                     00002090
      C(13) = HT(2)                                                     00002100
      DO 18 I=1,6                                                       00002110
      XI(I)=XII(I)                                                      00002120
      XC(I)=XII(I)                                                      00002130
      XB(I)=XII(I)                                                      00002140
      C4(I)=0.D0                                                        00002150
   18 CONTINUE                                                          00002160
      IF(K .NE. 0) GO TO 100                                            00002170
C  THE COMMANDS FOLLOWING THIS COMMENT UP TO AND INCLUDING STATEMENT    00002180
C  NUMBER 100 ARE PERFORMED ONLY THE FIRST TIME THROUGH GEOSY           00002190
      IF(IP1COR.EQ.1.OR.IP1COR.EQ.3) CALL CONVET(P1I,XI,XI(4),2,P1I)    00002200
      IF(IP2COR.EQ.1.OR.IP2COR.EQ.3) CALL CONVET(P2I,XI,XI(4),2,P2I)    00002210
      WRITE (6,650)                                                     00002220
  650 FORMAT(//,25X,'BEFORE COAST',//)                                  00002230
C  MTXPR FINDS THE CORRELATION EIGENVALUES AND MATRIX FOR A COVARIANCE  00002240
C  MATRIX                                                               00002250
      IF(NCONF .GT. 2 .AND. IP1COR .GT. 0) CALL MTXPR(XI,P1I,E,EV,XMU)  00002260
      WRITE(6,651)                                                      00002270
  651 FORMAT(//25X,'O-D ERRORS'//)                                      00002280
      IF(NCONF .GT. 2 .AND. IP2COR .GT. 0) CALL MTXPR(XI,P2I,EN,EVN,XMU)00002290
      RXX=FNORM(XI)                                                     00002300
      VXX=FNORM(XI(4))                                                  00002310
      WRITE(6,692) RXX,VXX                                              00002320
      WRITE(6,700) (NAMES(I),I=1,6),(C2(I),I=1,6)                       00002330
C  PEROD=DESIRED PERIOD                                                 00002340
      PEROD=SDAY*(ALAMD/(TCOV-ALAMD)+1.D0)                              00002350
      DSMA=DEXP(DLOG(XMU*PEROD**2/(4.D0*P1**2))/3.D0)                   00002360
      AI=C2(3)/R2D                                                      00002370
      APF=C2(5)/R2D                                                     00002380
      AN=C2(4)/R2D                                                      00002390
      ANS=AN+DELNO/R2D                                                  00002400
      SNODE=ANS                                                         00002410
  100 CONTINUE                                                          00002420
      IF(NCONF.NE.1) GO TO 761                                          00002430
C  ORB CONVERTS CARTESIAN TO KEPLERIAN ELEMENTS                         00002440
      CALL ORB(XII,XII(4),XMU,C2)                                       00002450
      AII=AINSY*D2R                                                     00002460
      AIS=DABS(AIS)                                                     00002470
      DO 761 I=1,6                                                      00002480
      XI(I)=XII(I)                                                      00002490
      XC(I)=XII(I)                                                      00002500
      XB(I)=XII(I)                                                      00002510
      C4(I)=0.D0                                                        00002520
  761 CONTINUE                                                          00002530
      IF (K.EQ.0) GO TO 522                                             00002540
C  RANDOM CAUSES A RANDOM ERROR TO BE GENERATED WHICH IS ADDED TO THE   00002550
C  STATE VECTOR TO PRODUCE A STATE VECTOR WITH ERROR                    00002560
      IF(IP1COR .GT. 0) CALL RANDOM(EV,E,XB,XC,IKEY,IFRN)               00002570
      IF(IFLAG.NE.0) GO TO 553                                          00002580
      IF(IP2COR .LT. 0 .OR. P2I(1,1) .EQ. 0.D0) GO TO 521               00002590
C  SAMPLE NAV. COV. MATRIX                                              00002600
      IF(IP2COR .GT. 0) CALL RANDOM(EVN,EN,XC,XCN,IKEY,IFRN)            00002610
  522 IF(K.GT.0) GO TO 524                                              00002620
  521 DO 523 I=1,6                                                      00002630
      XCN(I)=XC(I)                                                      00002640
  523 CONTINUE                                                          00002650
  524 CONTINUE                                                          00002660
      IF(IFLAG.NE.0) GO TO 553                                          00002670
C  DRIFT ORBIT CALCULATIONS BEGIN                                       00002680
C  PREP IS CALLED TO PERFORM AN AKM MANEUVER                            00002690
      CALL PREP(XCN,XCN(4),ALAMD,XISP,THRUST,W,SNODE,AINSY,DELNO,PITCHI,00002700
     .YAWI,DTC,DTB,WC,C3,C3(4),XMU,DV,PITCH,YAW,LEG,K,DVIN,IGUID,DSMA,  00002710
     .TERR,ITOPT,ALPHA,BETA,NCONF,ALI,ALF,ALD,FPA,TAMAN,C4,SIGBI,       00002720
     1 IKEY,IFRN)                                                       00002730
      ALPHAD=ALPHA*R2D                                                  00002740
      BETAD =BETA*R2D                                                   00002750
      SNOD=SNODE*R2D                                                    00002760
      IF(SNOD.LT.0.D0) SNOD=SNOD + 360.D0                               00002770
      IF(P2I(1,1).EQ.0.D0) GO TO 535                                    00002780
      ND=1                                                              00002790
      CALL STEPD(ND,DTC,TA,XC,XC(4),XMU,C3,C3(4),1,C1)                  00002800
  535 CONTINUE                                                          00002810
      DO 537 I = 1,6                                                    00002820
      XC(I) = C3(I)                                                     00002830
      IF (I.GE.4) XC(I) = C3(I)+C4(I-3)                                 00002840
  537 CONTINUE                                                          00002850
C  COMPUTE RA AND DEC OF VELOCITY VECTOR IN SYNCHRONOUS ORBIT           00002860
      CALL VNORM(C4,C5)                                                 00002870
      CALL SARA(C5(1),RASYN,DECSYN,1)                                   00002880
      RASYN = RASYN*R2D                                                 00002890
      DECSYN = DECSYN*R2D                                               00002900
      IF(ITI.GT.0)GO TO 553                                             00002910
      IF (K.GT.0) GO TO 553                                             00002920
      WRITE (6,691) DTC,DTB,WC,DV,PITCH,YAW                             00002930
C  WIGN=WEIGHT AFTER THE AKM BURN                                       00002940
      WIGN=WI + WC - WAH                                                00002950
      WRITE(6,902) WIGN                                                 00002960
  902 FORMAT( /,'  WEIGHT AFTER ABM BURN,        M1=',E15.8, /)         00002970
      DVIN=DV*XKM2F                                                     00002980
      RXX = FNORM(C3)                                                   00002990
      VXX = FNORM(C3(4))                                                00003000
      VYY = FNORM(XC(4))                                                00003010
      WRITE (6,693) RXX,VXX,VYY,C3,XC                                   00003020
  553 CONTINUE                                                          00003030
C  COMPUTE PLANE CHANGE BETWEEN DRIFT AND SYNCHRONOUS ORBITS            00003040
       IF(IFLAG.EQ.0) GOTO 554                                          00003050
       DO 201 I=1,6                                                     00003060
       C3(I)=C2(I)                                                      00003070
       XC(I)=XII(I)                                                     00003080
  201  CONTINUE                                                         00003090
  554  CONTINUE                                                         00003100
      CALL UCROSS(C3(1),C3(4),HDRFT)                                    00003110
      CALL UCROSS(XC(1),XC(4),UNSYN)                                    00003120
      CDP=DOT(HDRFT,UNSYN)                                              00003130
      IF(CDP .GT. 1.0D0) CDP=1.0D0                                      00003140
      IF(CDP .LT. (-1.0D0)) CDP=-1.0D0                                  00003150
      DPLANE = DARCOS(CDP)*R2D                                          00003160
C  CONVERT CARTESIAN TO KEPLERIAN ELEMENTS                              00003170
      CALL ORB(XC,XC(4),XMU,A)                                          00003180
      AI=A(3)/R2D                                                       00003190
      APF=A(5)/R2D                                                      00003200
      AN=A(4)/R2D                                                       00003210
      DMM=(DSQRT(XMU/A(2))/A(2))                                        00003220
C  DPER=PERIOD IN DRIFT ORBIT, FROM KEPLER'S 3RD LAW                    00003230
      DPER=2.D0*P1/DMM                                                  00003240
      DRIFT=TCOV*(DPER-SDAY)/DPER                                       00003250
      A(8)=A(2) * (1.D0+A(1))                                           00003260
      A(7) = A(2)*(1.D0-A(1))                                           00003270
      A(9) = 0.D0                                                       00003280
      A(10)=0.D0                                                        00003290
      A(11)=0.D0                                                        00003300
      A(12)=0.D0                                                        00003310
      DDRIFT=ALAMD                                                      00003320
      SAVERA=A(8)                                                       00003330
      SAVERP=A(7)                                                       00003340
      SAVEA=A(2)                                                        00003350
      SAVEE=A(1)                                                        00003360
      IF(TAMAN.GT.0.0D0)AII=AI                                          00003370
C  DRFTDV COMPUTES THE DELTA-V REQUIRED TO ACHIEVE THE DESIRED DRIFT    00003380
C  RATE.  A(15) WILL CONTAIN THIS DELTA-V VALUE.                        00003390
      CALL DRFTDV(A,DDRIFT,DRIFT,DRTOL, DSMA,STAFI,AP,TUB,K)            00003400
      TEMP = 3280.84D0/XISPH/32.174D0                                   00003410
      A(15) = A(9)                                                      00003420
      A(16)=-WIGN*(DEXP(-1.D0 *  A(10)*TEMP) - 1.D0)                    00003430
      A(8)=A(2)*(1.D0+A(1))                                             00003440
      A(7)=A(2)*(1.D0-A(1))                                             00003450
C  SYNCHRONOUS ORBIT CALCULATIONS BEGIN                                 00003460
C                                                                       00003470
C  DELVS IS A SUBDRIVER THAT CALLS INTO ACTION SUBROUTINES AEIN, AP, &  00003480
C  PA IN ORDER TO DETERMINE THE DELTA-V REQUIREMENTS FOR ATTAINING THE  00003490
C  GEOSYNCHRONOUS ORBIT FROM THE DRIFT ORBIT.  A(11)= OUT OF PLANE      00003500
C  DELTA-V, A(10)= INPLANE DELTA-V, & A(9)= TOTAL DELTA-V               00003510
C                                                                       00003520
      A(17)=0.D0                                                        00003521
      DUM1=0.                                                           00003522
      DUM2=0.                                                           00003523
 120  CALL DELVS(A(2),A(8),A(7),AS, ES,VREOR,AI,AII,AN,SNODE,XMU,A(9),  00003530
     2 DVN,APF,ASM,ESM,A(10),A(11),AMAN)                                00003540
      A(20)=DPLANE                                                      00003550
      A(21)=UNSYN(1)                                                    00003560
      A(22)=UNSYN(2)                                                    00003570
C  THE NEXT SEVEN STATEMENTS ENABLE DELVS TO BE USED TO CALCULATE A(17) 00003580
C  THE DELTA-V REQUIREMENT, IF ONLY AN INCLINATION CHANGE IS DESIRED.   00003590
C  AMAN(1)=4 AND THE -1.D0 INPUT IN DELVS ENABLE A(17) TO BE FOUND      00003600
      AMNO1=AMAN(1)                                                     00003610
      AMNO2=AMAN(2)                                                     00003620
      AMAN(1)=4.D0                                                      00003630
      AMAN(2)=0.D0                                                      00003640
      CALL DELVS(A(2),A(8),A(7),AS, ES,VREOR,AI,AII,AN,SNODE,XMU,DUM1,  00003650
     2 -1.D0,APF,ASM,ESM,DUM2,A(17),AMAN)                               00003660
      AMAN(1)=AMNO1                                                     00003670
      AMAN(2)=AMNO2                                                     00003680
      A(23)=DSQRT(A(10)*A(10)+A(11)*A(11))                              00003690
      A(18)=RASYN                                                       00003700
      A(19)=DECSYN                                                      00003710
      A(24)=-WIGN*(DEXP(-1.D0 * A(23) * TEMP) - 1.D0)                   00003720
C  SYNCHRONOUS ECCENTRICITY A(25)                                       00003730
      A(25)=ES                                                          00003740
  147 CONTINUE                                                          00003750
C                                                                       00003760
      A(01)=SAVEE                                                       00003770
      A(02)=SAVEA                                                       00003780
      A(12)=DRIFT                                                       00003790
      A(08)=SAVERA                                                      00003800
      A(07)=SAVERP                                                      00003810
      TEMP=A(9)*XKM2F/XISPH/G0                                          00003820
      A(13)=WIGN*DEXP(-1.D0*TEMP)                                       00003830
      A(14)=WIGN-A(13)                                                  00003840
      IF(NCONF.NE.1)GO TO 730                                           00003850
      A10=A(10)*1000.D0                                                 00003860
      A11=A(11)*1000.D0                                                 00003870
      A9 =A(9)*1000.D0                                                  00003880
      A15=A(15)*1000.D0                                                 00003890
C  THE TAMAN VALUE DETERMINES WHICH SET OF OUTPUT PARAMETERS ARE PRINTED00003900
C  IN SPECIFIC, THE DEFINITIONS OF XOPT THROUGH QOPTD ARE DIFFERENT     00003910
C  DEPENDING ON WHETHER TAMAN=0 OR TAMAN .NE. 0                         00003920
      IF(TAMAN .NE. 0.0) GO TO 705                                      00003930
      IF(ITI.LE.1) WRITE(6,731)                                         00003940
      XOPT = SNOD                                                       00003950
      YOPT = AINSY                                                      00003960
      POPT=FPA                                                          00003970
      QOPT=AII                                                          00003980
      POPTD=FPA                                                         00003990
      QOPTD=AII*R2D                                                     00004000
      GOTO 708                                                          00004010
  705 IF(ITI .LE. 1) WRITE(6,734)                                       00004020
      XOPT = DELNO                                                      00004030
      YOPT = TAMAN                                                      00004040
      POPT=AI                                                           00004050
      QOPT=AN                                                           00004060
      POPTD=AI*R2D                                                      00004070
      QOPTD=AN*R2D                                                      00004080
 708  WRITE(6,732) XOPT,YOPT,ALPHAD,BETAD,POPTD,A(5),A(1),A(25),A(12),  00004090
     .A10,QOPTD,A15,A9,A(14)                                            00004100
      IF(LU9 .GT. 0) WRITE(LU9)XOPT,YOPT,ALPHAD,BETAD,POPTD,            00004110
     *A(5),A(1),A(25),A(12),A10,QOPTD,A15,A9,A(14)                      00004120
      IF(ITI.EQ.0) ITI=2                                                00004130
      IF(ITI.GT.50)ITI=0                                                00004140
      ITI=ITI+1                                                         00004150
      IF(TAMAN.NE.0.0)TAMAN=TAMAN+DIS                                   00004160
      IF(TAMAN.EQ.0.0)AINSY=AINSY+DIS                                   00004170
      IF(AINSY.GT.FIS.AND.TAMAN.EQ.0.0D0)GOTO710                        00004180
      IF(TAMAN.GT.FIS.AND.TAMAN.NE.0.0D0)GOTO710                        00004190
      GO TO 100                                                         00004200
  710 DELNO=DELNO+DNS                                                   00004210
      IF(TAMAN.NE.0.0D0)GOTO715                                         00004220
      IF(SNOD.GT.FNS.AND.DNS.GT.0.D0) GO TO 730                         00004230
      IF(SNOD.LT.FNS.AND.DNS.LT.0.D0) GO TO 730                         00004240
      AINSY=AINSYI                                                      00004250
      WRITE(6,733)                                                      00004260
      GO TO 100                                                         00004270
 715  IF(DELNO.GT.FNS.AND.DNS.GT.0.0D0)GOTO730                          00004280
      IF(DELNO.LT.FNS.AND.DNS.LT.0.0D0)GOTO730                          00004290
      TAMAN=TAMANI                                                      00004300
      WRITE(6,734)                                                      00004310
      GOTO100                                                           00004320
  730 CONTINUE                                                          00004330
      IF(NCONF.EQ.1 .AND. LU9 .GT. 0) ENDFILE LU9                       00004340
  691 FORMAT(/13X,'DTC',18X,'DTB',19X,'WC',19X,'DV',16X,'PITCH',18X,    00004350
     1  'YAW'/6D21.13)                                                  00004360
  693 FORMAT(/9X,'R COAST',14X,'V COAST',15X,'V BURN'/3D21.13//5X,      00004370
     1 'STATE AFTER COAST'/6D21.13//5X,'STATE AFTER BURN'/6D21.13)      00004380
  692 FORMAT(/15X,'R',18X,'V',/2D21.13)                                 00004390
  700 FORMAT(/5X,24HORBITAL ELEMENTS NOMINAL/6(13X,A8)/6D21.13)         00004400
  731 FORMAT('1',//,3X,'FNODE',5X,'INC',6X,'RA',7X,'DEC',               00004410
     1 6X,'FPA',5X,'AOP',5X,'ECC',4X,'ECCSYN',2X,'DRIFT+W',4X,          00004420
     2 'DV-AE',4X,'I-SYN',3X,'DV-DRFT',4X,'DVTOT',4X,'WT-HYD',/,        00004430
     3 3X,'(DEG)',4(4X,'(DEG)'),3X,'(DEG)',3X,'(N/A)',3X,'(N/A)',       00004440
     4 3X,'(DEG/DY)',2X,'(M/SEC)',2X,' (DEG) ',2X,'(M/SEC)',3X,         00004450
     5  '(M/SEC)',4X,'(LBS)'/)                                          00004460
  732 FORMAT(1X,F8.3,1X,F8.3,1X,F8.3,2X,F7.3,2X,F6.2,1X,F7.2,3X,        00004470
     1 F6.5,1X,F6.5,1X,F8.2,2X,F7.0,2(2X,F7.1),2(3X,F7.0))              00004480
  733 FORMAT(/)                                                         00004490
  734 FORMAT('1',//,4X,'DIHED',5X,'TA ',6X,'RA',7X,'DEC',               00004500
     1 6X,'INC',5X,'AOP',5X,'ECC',4X,'ECCSYN',3X,'DRIFT+W',4X,          00004510
     2 'DV-AE',4X,'NODE ',3X,'DV-DRFT',4X,'DVTOT',4X,'WT-HYD',/,        00004520
     3 4X,'(DEG)',4(4X,'(DEG)'),3X,'(DEG)',3X,'     ',3X,'     ',       00004530
     4 4X,'(DEG/DY)',3(2X,'(M/SEC)'),3X,'(M/SEC)',4X,'(LBS)'/)          00004540
      DO 800 I=1,25                                                     00004550
      B(I) = C(I)                                                       00004560
      B(I+25) = A(I)                                                    00004570
      ELH(I) = GELH(I)                                                  00004580
      ELH(I+25) = ELT(I)                                                00004590
  800 CONTINUE                                                          00004600
C  SCOUT OUTPUTS THE ORBITAL PARAMETERS IN THE SCAN MODE.               00004610
      CALL SCOUT(B,ELH,ELHU)                                            00004620
      RETURN                                                            00004630
      END                                                               00004640
C          DATA SET GOTOR      AT LEVEL 002 AS OF 06/19/79
C          DATA SET GOTOR      AT LEVEL 001 AS OF 04/04/78              00001
      SUBROUTINE GOTOR(K,VM,C,F,E1)                                     00002
C                                                                       00003
C     SUBROUTINE GOTOR (K,VM,C,F,E1)                                    00004
C                                                                       00005
C                                                                       00006
C     THE PURPOSE OF GOTOR IS TO SOLVE A MODIFIED FORM OF KEPLER'S      00007
C        EQUATION FOR THE INCREMENTED ECCENTRIC ANOMALY THAT CORRESPONDS00008
C        TO A GIVEN INCREMENTAL MEAN ANOMALY.                           00009
C                                                                       00010
C                                                                       00011
C                                                                       00012
C     ARGUMENTS IN THE CALLING SEQUENCE ARE DEFINED AS FOLLOWS.         00013
C                                                                       00014
C         ARGUMENT   TYPE    I/O        DEFINITION                      00015
C                                                                       00016
C          K         R*8      I      ORBIT FLAG,                        00017
C                                       =1, ELLIPTIC                    00018
C                                       =2, HYPERBOLIC                  00019
C          VM        R*8      I      INCREMENTAL MEAN ANOMALY           00020
C          C(2)      R*8      I      KEPLER'S EQUATION COEFFICIENTS     00021
C          F(4)      R*8      O      FUNCTIONS OF THE INCREMENTAL       00022
C                                       ECCENTRIC ANOMALY.              00023
C                                    FOR ELLIPTIC ORBITS (K=1),         00024
C                                       F(1)=(DELTA E)-SIN(DELTA E)     00025
C                                       F(2)=1-COS(DELTA E)             00026
C                                       F(3)=SIN(DELTA E)               00027
C                                       F(4)=COS(DELTA E)               00028
C                                    FOR HYPERBOLIC ORBITS (K=2),       00029
C                                       F(1)=SINH(DELTA E)-(DELTA E)    00030
C                                       F(2)=COSH(DELTA E)-1            00031
C                                       F(3)=SINH(DELTA E)              00032
C                                       F(4)=COSH(DELTA E)              00033
C          E1        R*8     I/O     INCREMENTAL ECCENTRIC ANOMALY      00034
C                                                                       00035
C                                                                       00036
C                                                                       00037
C     GOTOR IS CALLED BY THE FOLLOWING SUBROUTINES.                     00038
C                                                                       00039
C         STEPD                                                         00040
C                                                                       00041
C                                                                       00042
C                                                                       00043
C     NO SUBROUTINES ARE CALLED BY GOTOR.                               00044
C                                                                       00045
C                                                                       00046
C                                                                       00047
C     GOTOR NEITHER USES NOR ALTERS VARIABLES IN COMMON. ALL INPUT AND  00048
C         OUTPUT IS THROUGH THE CALLING SEQUENCE.                       00049
C                                                                       00050
C                                                                       00051
C                                                                       00052
      IMPLICIT REAL*8(A-H,O-Z,$)                                        00053
      DIMENSION C(2),F(4)                                               00054
      NMAX=20                                                           00055
      N=0                                                               00056
      GO TO (1,2),K                                                     00057
    1 CONTINUE                                                          00058
C     FIRST GUESS IS OBTAINED FOR ELLIPTICAL CASE                       00059
    8 CONTINUE                                                          00060
      IF(E1-1.0D0)30,31,31                                              00061
   30 CONTINUE                                                          00062
      D2=E1*E1                                                          00063
C  CALCULATE (DELTA E)- SIN(DELTA E)                                    00064
      F(1)=E1*D2*(.16666667D+00-D2*(.833333333D-02-D2*(.198412698D-03-D200065
     1*(.275573192D-05-D2*.250521083D-07))))                            00066
C  CALCULATE 1-COS(DELTA E)                                             00067
      F(2)= D2*(0.5D0-D2*(.41666667D-01-D2*(.13888889D-02-D2*(.24801587D00068
     1-04-D2*.27557319D-06))))                                          00069
C  CALCULATE SIN(DELTA E)                                               00070
      F(3)=E1-F(1)                                                      00071
C  CALCULATE COS(DELTA E)                                               00072
      F(4)=1.0D0-F(2)                                                   00073
      GO TO 3                                                           00074
   31 CONTINUE                                                          00075
      F(3)=DSIN(E1)                                                     00076
      F(4)=DCOS(E1)                                                     00077
      F(1)=E1-F(3)                                                      00078
      F(2)=1.0D0-F(4)                                                   00079
      GO TO 3                                                           00080
    2 CONTINUE                                                          00081
C     FIRST GUESS IS OBTAINED FOR HYPERBOLIC CASE                       00082
    9 CONTINUE                                                          00083
      IF(E1-1.0D0)32,33,33                                              00084
   32 CONTINUE                                                          00085
      D2=E1*E1                                                          00086
C  CALCULATE SINH(DELTA E)-(DELTA E)                                    00087
      F(1) =E1*D2*(.16666667D+00+D2*(.83333333D-02+D2*(.198412698D-03+D200088
     1*(.275573192D-05+D2*.250521083D-07))))                            00089
C  CALCULATE COSH(DELTA E) - 1                                          00090
      F(2)  =D2*(0.5D0+D2*(.41666667D-01+D2*(.13888889D-02+D2*(.2480158700091
     1D-04+D2*.27557319D-06))))                                         00092
C  CALCULATE SINH(DELTA E)                                              00093
      F(3)=E1+F(1)                                                      00094
C  CALCULATE COSH(DELTA E)                                              00095
      F(4)=1.0D0+F(2)                                                   00096
      F(4)=1.0D0+F(2)                                                   00097
      GO TO 3                                                           00098
   33 CONTINUE                                                          00099
      EX=.5D0*DEXP(E1)                                                  00100
      OX=.25D0/EX                                                       00101
      F(3)=EX-OX                                                        00102
      F(4)=EX+OX                                                        00103
      F(1)=F(3)-E1                                                      00104
      F(2)=F(4)-1.0D0                                                   00105
    3 CONTINUE                                                          00106
      CM=F(1)+C(1)*F(3)+C(2)*F(2)                                       00107
      DM=F(2)+C(1)*F(4)+C(2)*F(3)                                       00108
      VMCM=VM-CM                                                        00109
      DE=(VM-CM)/DM                                                     00110
      ERROR=DE                                                          00111
      AB=DABS(DE)                                                       00112
      IF(AB-1.0D0)10,10,11                                              00113
   11 DE=DE/AB                                                          00114
C  COMPUTE E2, THE NEXT ESTIMATE FOR DELTA E                            00115
   10 E2=E1+DE                                                          00116
C     IF(DABS((E2-E1)/(E2+E1))-3.D-8)4,4,5                              00117
C  THE ITERATION PROCEDURE IS HALTED WHEN THE N+1 ST (DELTA E) VALUE    00118
C  MINUS THE N TH (DELTA E) VALUE IS LESS THAN OR EQUAL TO 3*D-8        00119
      IF(DABS(E2+E1)-3.D-8)4,4,60                                       00120
   60 IF(DABS(E2-E1)-3.D-8)4,4,5                                        00121
    5 CONTINUE                                                          00122
C  CHECKING TO SEE WHETHER OR NOT THE SPECIFIED MAXIMUM NUMBER OF       00123
C  ITERATIONS (NMAX) THROUGH GOTOR HAS BEEN ATTEMPTED                   00124
      IF(N-NMAX)6,7,7                                                   00125
    7 CONTINUE                                                          00126
      GO TO 4                                                           00127
    6 CONTINUE                                                          00128
      N=N+1                                                             00129
      E1=E2                                                             00130
      GO TO (8,9),K                                                     00131
    4 CONTINUE                                                          00132
      RETURN                                                            00133
      END                                                               00134
C          DATA SET GUIDE      AT LEVEL 004 AS OF 06/25/79
C          DATA SET GUIDE      AT LEVEL 003 AS OF 05/31/79              00001
C          DATA SET GUIDE      AT LEVEL 002 AS OF 05/22/79              00002
C          DATA SET GUIDE      AT LEVEL 001 AS OF 04/04/78              00003
      SUBROUTINE GUIDE(A,K,ELT)                                         00004
C                                                                       00005
C  SUBROUTINE GUIDE(A,K,ELT)                                            00006
C                                                                       00007
C  THE PURPOSE OF GUIDE IS TO CALL INTO ACTION THE SUBROUTINES THAT     00008
C  SIMULATE A MISSION FROM THE INITIAL ORBIT TO TARGET ENCOUNTER        00009
C                                                                       00010
C                                                                       00011
C  ARGUMENTS IN THE CALLING SEQUENCE ARE DEFINED AS FOLLOWS:            00012
C                                                                       00013
C  ARGUMENT  TYPE  I/O    DEFINITION                                    00014
C                                                                       00015
C    A       R*8    O     ARRAY CONTAINING TRAJECTORY PARAMETERS        00016
C    K       I*4    I     K=0, COMPUTE COVARIANCE MATRICES AND          00017
C                         INITIALIZE VARIABLES; K>0, SKIP               00018
C                         INITIALIZATION AND COMPUTATION OF             00019
C                         COVARIANCE MATRICES                           00020
C    ELT     R*8    O     ARRAY CONTAINING THE OUTPUT TITLES            00021
C                         CORRESPONDING TO THE A ARRAY                  00022
C                                                                       00023
C  GUIDE IS CALLED BY THE FOLLOWING SUBROUTINE:                         00024
C                                                                       00025
C    MAIN                                                               00026
C                                                                       00027
C  THE FOLLOWING SUBROUTINES ARE CALLED BY GUIDE:                       00028
C                                                                       00029
C    CONVET, MODE2, MTXPR, RANDOM, STEPD                                00030
C                                                                       00031
C                                                                       00032
C  THE VARIABLES APPEARING IN A COMMON BLOCK ARE GIVEN BELOW:           00033
C                                                                       00034
C  COMMON VARIABLES USED:                                               00035
C                                                                       00036
C   IFRN IKEY IP1COR IP2COR IP3COR IP4COR IP5COR IP6COR                 00037
C   P1I P2I P3I P4I P5I P6I SIGBI XII XMU                               00038
C                                                                       00039
C                                                                       00040
      IMPLICIT REAL*8(A-H,O-Y)                                          00041
      REAL*8 NAMES                                                      00042
      COMMON/GENRL/ P1,PI(6,6),XII(6),XMU,NAMES(6),PITCHI,YAWI,WI,      00043
     A P1I(6,6),P2I(6,6),P3I(6,6),P4I(6,6),P5I(6,6),P6I(6,6),TOLR(25),  00044
     2 THRUSI,SIGBI(3),ZDELT,ZUB(3,25),                                 00045
     3 IP1COR,IP2COR,IP3COR,IP4COR,IP5COR,IP6COR,                       00046
     4 ICOV(25),IHIST(25),IPCOOR,ITPSTR,NCONF,MODE                      00047
     2 ,IKEY,IFRN                                                       00048
      COMMON /COMT/ DT1I,DT2I,DT3I,DT4I,DT5I,DT6I,XTI(6),X2I(6),XMU2    00049
      DIMENSION ELT(25),TELT(25)                                        00050
      DIMENSION XI(6),XT(6),X2(6),XC(6),XB(6),C4(6),C(6,6),SIGB(3),     00051
     1 A(50),E(6),EV(6,6),ET(6),EVT(6,6),ET2(6),EVT2(6,6),ET3(6),       00052
     2 EVT3(6,6),ETE(6),EVTE(6,6),ETK(6),EVTK(6,6),C1(6,6),C3(6)        00053
      DATA TELT/'DELV1','DELV2','DELV3','DELVT',                        00054
     1 'MISS','MISS.SC','DT','DV1ANG',                                  00055
     2 'DV2ANG','DV3ANG','MISS.T','MISS.R',                             00056
     3 'DELV4','DV4ANG','X.ENC','Y.ENC',                                00057
     4 'Z.ENC','XD.ENC','YD.ENC','ZD.ENC',                              00058
     6 'PARAM21','PARAM22','PARAM23','PARAM24',                         00059
     7 'PARAM25'/                                                       00060
      IF(K.NE.0) GO TO11                                                00061
      WRITE(6,300)DT1I,DT2I,DT3I,DT4I,DT5I,DT6I                         00062
  300 FORMAT(1H0,57X,'GUIDEI OPTION INPUTS',/,9X,                       00063
     1'DT1I =',D20.12,2X,'DT2I =',D20.12,2X,                            00064
     2'DT3I =',D20.12,/,9X,'DT4I =',D20.12,2X,                          00065
     3'DT5I =',D20.12,2X,'DT6I =',D20.12,/)                             00066
      WRITE (6,310) SIGBI,X2I,XTI                                       00067
 310  FORMAT(/5X,'SIGBI'/3D21.13//5X,'X2I'/6D21.13//5X,'XTI'/6D21.13)   00068
C  PRINT THE GRAVITATIONAL PARAMETERS FOR THE EARTH AND THE SUN         00069
      WRITE(6,320) XMU,XMU2                                             00070
  320 FORMAT(1H0,5X,'XMU =',D21.13,/,5X,'XMU2 =',D21.13)                00071
      DT1 =DT1I                                                         00072
      DT2 =DT2I                                                         00073
      DT3 =DT3I                                                         00074
      DT4 =DT4I                                                         00075
      DT5 =DT5I                                                         00076
      DT6 =DT6I                                                         00077
      DO 5 I=1,25                                                       00078
      ELT(I)=TELT(I)                                                    00079
    5 CONTINUE                                                          00080
      DO 10 I=1,6                                                       00081
      XI(I) = XII(I)                                                    00082
      XT(I) = XTI(I)                                                    00083
      X2(I) = X2I(I)                                                    00084
      XC(I) = XI(I)                                                     00085
      XB(I) = XI(I)                                                     00086
      C4(I) = 0.D0                                                      00087
      DO 9 J=1,6                                                        00088
      C(I,J) = 0.D0                                                     00089
    9 CONTINUE                                                          00090
   10 CONTINUE                                                          00091
C  INITIALIZE TARGET OR PATCH POINT STATES                              00092
      IF((XT(1)*XT(2)*XT(3)).NE.0.D0) GO TO 6                           00093
      NSD=1                                                             00094
      CALL STEPD(NSD,DT6-DT1,TA,X2,X2(4),XMU2,XT,XT(4),1,C1)            00095
    6 IF((X2(1)*X2(2)*X2(3)).NE.0.D0) GO TO 7                           00096
      NSD=1                                                             00097
      CALL STEPD(NSD,DT1-DT6,TA,XT,XT(4),XMU2,X2,X2(4),1,C1)            00098
    7 CONTINUE                                                          00099
C                                                                       00100
      SIGB(1) = SIGBI(1)                                                00101
      SIGB(2) = SIGBI(2)                                                00102
      SIGB(3) = SIGBI(3)                                                00103
C  COMPUTE THE NECESSARY COVARIANCE MATRICES TRANSFORMED FROM THE LOCAL 00104
C  TANGENT SYSTEM TO THE EQUATORIAL SYSTEM (P1I THROUGH P5I)            00105
       IF(IP1COR.EQ.1.OR.IP1COR.EQ.3) CALL CONVET(P1I,XI,XI(4),2,P1I)   00106
       IF(IP2COR.EQ.1.OR.IP2COR.EQ.3) CALL CONVET(P2I,XT,XT(4),2,P2I)   00107
       IF(IP3COR.EQ.1.OR.IP3COR.EQ.3) CALL CONVET(P3I,XT,XT(4),2,P3I)   00108
       IF(IP4COR.EQ.1.OR.IP4COR.EQ.3) CALL CONVET(P4I,XT,XT(4),2,P4I)   00109
       IF(IP5COR.EQ.1.OR.IP5COR.EQ.3) CALL CONVET(P5I,XT,XT(4),2,P5I)   00110
      WRITE(6,700)                                                      00111
      CALL MTXPR(XI,P1I,E,EV,XMU)                                       00112
      WRITE(6,701)                                                      00113
      CALL MTXPR(XT,P2I,ET,EVT,XMU2)                                    00114
      WRITE(6,702)                                                      00115
      CALL MTXPR(XT,P3I,ET2,EVT2,XMU2)                                  00116
      WRITE(6,703)                                                      00117
      CALL MTXPR(XT,P4I,ET3,EVT3,XMU2)                                  00118
      WRITE(6,704)                                                      00119
      CALL MTXPR(XT,P5I,ETE,EVTE,XMU2)                                  00120
   11 NSD=1                                                             00121
C  PROPAGATE TO PATCH POINT NOMINAL                                     00122
      CALL STEPD(NSD,DT1,TA,XB,XB(4),XMU,C4,C4(4),1,C1)                 00123
      IF(K.GT.0) CALL RANDOM(EV,E,XB,XC,IKEY,IFRN)                      00124
      NSD=1                                                             00125
C  PROPAGATE TO PATCH POINT TIME                                        00126
      CALL STEPD(NSD,DT1,TA,XC,XC(4),XMU,C3,C3(4),1,C1)                 00127
C  PATCH POINT STATE                                                    00128
      DO 557 I=1,6                                                      00129
      C3(I)=C3(I)-C4(I)+X2(I)                                           00130
  557 CONTINUE                                                          00131
      NSD=1                                                             00132
C  PROPAGATE TO FIRST BURN                                              00133
      CALL STEPD(NSD,DT2,TA,C3,C3(4),XMU2,XC,XC(4),1,C1)                00134
      IF(K.NE.0) GO TO 20                                               00135
      CALL MODE2(XC,XT,C,C,C,C,C,C,C,C,C,C,C,DT3,DT4,DT5,DT6-DT1-DT2,   00136
     * A(1),XMU2,A(15))                                                 00137
      IF(IP6COR.EQ.1.OR.IP6COR.EQ.3) CALL CONVET(P6I,A(15),A(18),2,P6I) 00138
      WRITE(6,790) (A(I),I=15,20)                                       00139
      WRITE(6,705)                                                      00140
      CALL MTXPR(A(15),P6I,ETK,EVTK,XMU2)                               00141
      RETURN                                                            00142
C  MISSION SIMULATION ROUTINE                                           00143
   20 CALL MODE2(XC,XT,ET,EVT,ET2,EVT2,ET3,EVT3,ETK,EVTK,ETE,           00144
     1  EVTE,SIGB,DT3,DT4,DT5,DT6-DT1-DT2,A(1),XMU2,A(15))              00145
  790 FORMAT(/5X,'NOMINAL STATE VECTOR AT ENCOUNTER'/6D21.13)           00146
  700 FORMAT(//25X,'INITIAL COVARIANCE'//)                              00147
  701 FORMAT(//25X,' TARGET 1 ERRORS'//)                                00148
  702 FORMAT(//25X,'TARGET 2 ERRORS'//)                                 00149
  703 FORMAT(//25X,'TARGET 3 ERRORS'//)                                 00150
  704 FORMAT(//25X,'TARGET E ERRORS'//)                                 00151
  705 FORMAT(//25X,'S-CFT E ERRORS'//)                                  00152
  692 FORMAT(//5X,'RELATIVE INC',/,D21.13)                              00153
C                                                                       00154
C                                                                       00155
      RETURN                                                            00156
      END                                                               00157
C          DATA SET HISTO      AT LEVEL 004 AS OF 06/20/79
C          DATA SET HISTO      AT LEVEL 003 AS OF 05/31/79              00001
C          DATA SET HISTO      AT LEVEL 002 AS OF 04/07/78              00002
      SUBROUTINE HISTO(TITLE,NAME,P,X,XM,XS,NP,XNOM,NS,ITSTH,DELP,TESTP)00003
C                                                                       00004
C                                                                       00005
C  SUBROUTINE HISTO (TITLE,NAME,P,X,XM,XS,NP,XNOM,NS,ITSTH,DELP,TESTP)  00006
C                                                                       00007
C                                                                       00008
C                                                                       00009
C     THE PURPOSE OF HISTO IS TO PROVIDE OUTPUT OF THE STATE VARIABLE   00010
C         NOMINAL VALUE, MEAN VALUE, STANDARD DEVIATION VALUE, AND      00011
C         VALUES OF CUMULATIVE PROBABILITY. AN OPTION WILL PROVIDE A    00012
C         PROBABILITY PRINTER PLOT.                                     00013
C                                                                       00014
C                                                                       00015
C                                                                       00016
C     ARGUMENTS IN THE CALLING SEQUENCE ARE DEFINED AS FOLLOWS.         00017
C                                                                       00018
C         ARGUMENT   TYPE    I/O        DEFINITION                      00019
C                                                                       00020
C          TITLE(20) A*4      I      PRINTER PLOT TITLE                 00021
C          NAME(2)   A*4      I      STATE VARIABLE NAME                00022
C          P(NP)     R*4      I      PERCENT FREQUENCY OF EACH INTERVAL 00023
C          X(50)     R*4      I      INTERVAL LIMITS WITH RESPECT TO    00024
C                                       NOMINAL                         00025
C          XM        R*4      I      MEAN VALUE                         00026
C          XS        R*4      I      ONE-SIGMA VALUE                    00027
C          NP        I*4      I      NUMBER OF INTERVALS                00028
C          XNOM      R*4      I      NOMINAL VALUE                      00029
C          NS        I*4      I      NUMBER OF SAMPLES                  00030
C          ITSTH     I*4      I      PROBABILITY PLOT FLAG,             00031
C                                       .LT.0,NO PLOT GENERATED         00032
C                                       .GE.0,PLOT GENERATED            00033
C          DELP(9)   R*8      O      PERCENTILE VALUE WITH RESPECT TO   00034
C                                       NOMINAL                         00035
C          TESTP     R*8      I      PERCENTILE                         00036
C                                                                       00037
C                                                                       00038
C                                                                       00039
C     HISTO IS CALLED BY THE FOLLOWING SUBROUTINES.                     00040
C                                                                       00041
C         STATS                                                         00042
C                                                                       00043
C                                                                       00044
C     NO SUBROUTINES ARE CALLED BY HISTO.                               00045
C                                                                       00046
C                                                                       00047
C     HISTO NEITHER USES NOR ALTERS VARIABLES IN COMMON. ALL INPUT AND  00048
C         OUTPUT IS THROUGH THE CALLING SEQUENCE.                       00049
C                                                                       00050
C                                                                       00051
C                                                                       00052
      REAL*8 DINF,DELP,TESTP,VAL                                        00053
      DIMENSION TESTP(9),TSUM(51),DELP(9),VAL(9)                        00054
C                                                                       00055
      DATA DINF/1.0D70/                                                 00056
      DIMENSION TITLE(20),NAME(2),P(1),X(1),AL1(50)                     00057
      DATA BLANK/' '/                                                   00058
      DATA EYE/'I'/                                                     00059
      CALL ERRSET(208,256,-1,0001)                                      00060
C  ITSTH < 0 INDICATES NO PROBABILITY PLOT IS DESIRED                   00061
      IF(ITSTH.LT.0) GO TO 80                                           00062
C  PRINT OUT THE PROBABILITY PLOT TITLE                                 00063
      WRITE (6,600) TITLE                                               00064
   80 CONTINUE                                                          00065
      AM = XM+XNOM                                                      00066
      TSUM(51)=1.D0                                                     00067
C  PRINT OUT THE PARAMETER NAME, THE NAME OF, AND VALUES FOR, THE       00068
C  NOMINAL, MEAN, AND STANDARD DEVIATION FOR THE PARAMETER, AND THE     00069
C  SAMPLE SIZE FOR THE HISTOGRAM PLOT                                   00070
      WRITE (6,610) NAME,XNOM,AM,XS,NS                                  00071
      IF(ITSTH.LT.0) GO TO 81                                           00072
C  PRINT OUT THE COLUMN HEADINGS FOR THE HISTOGRAM, AND THE             00073
C  SPECIFIED INITIAL VALUES                                             00074
      WRITE (6,620) X(1),P(1),P(1)                                      00075
   81 CONTINUE                                                          00076
      PMAX = P(1)                                                       00077
C  THE FOLLOWING DO LOOP FINDS THE MAXIMUM VALUE OF THE P ARRAY         00078
      DO 10 I = 2,NP                                                    00079
      PMAX = AMAX1(PMAX,P(I))                                           00080
   10 CONTINUE                                                          00081
      ZP=NP                                                             00082
      IF(ZP.GT.50.)ZP=50.                                               00083
      IF(PMAX.LT.100.0)ALN=100.0                                        00084
      XMAX1=PMAX+5.0                                                    00085
      XNINT=XMAX1/ZP                                                    00086
      NINT=XNINT*10.0D0                                                 00087
      XNINT=NINT/10.D0                                                  00088
      ALN=XNINT*ZP                                                      00089
      IF(ALN.GT.100.0D0)ALN=100.0D0                                     00090
C  THE DO LOOP INITIALIZES THE AL1 ARRAY TO BLANKS                      00091
      DO 20 I = 1,50                                                    00092
      AL1(I) = BLANK                                                    00093
   20 CONTINUE                                                          00094
      DP=ALN/ZP                                                         00095
      SUM = P(1)                                                        00096
      TSUM(1)=P(1)                                                      00097
      DO 50 I = 1, NP                                                   00098
      DO 30 J = 1,NP                                                    00099
C  SET THE ARRAY MEMBER EQUAL TO I, IF THE CONDITION IS MET             00100
C  THE DO 20, DO 30, AND DO 50 DO LOOPS ARE USED TO SET THE VALUES      00101
C  (A BLANK OR AN I) IN THE AL1 ARRAY FOR SUBSEQUENT PRINTING IN THE    00102
C  HISTOGRAM, VIA THE WRITE(6,650) AND WRITE(6,660) STATEMENTS.         00103
      IF (P(J)+DP/2..GE.ALN) AL1(J) = EYE                               00104
   30 CONTINUE                                                          00105
      IP1 = I+1                                                         00106
      SUM = SUM+P(I+1)                                                  00107
      TSUM(I+1)=SUM                                                     00108
      IF(ITSTH.LT.0) GO TO 82                                           00109
      IF (I.GT.NP-2) GO TO 40                                           00110
      WRITE (6,650) ALN,AL1,IP1,X(I),X(I+1),P(I+1),SUM                  00111
      GO TO 48                                                          00112
   40 IF (I.GT.NP-1) GO TO 45                                           00113
      WRITE (6,660) ALN,AL1,IP1,X(I),P(I+1),SUM                         00114
      GO TO 48                                                          00115
   45 WRITE (6,650) ALN,AL1                                             00116
   82 CONTINUE                                                          00117
   48 ALN = ALN-DP                                                      00118
   50 CONTINUE                                                          00119
      IF(ITSTH.LT.0) GO TO 83                                           00120
C  PRINT OUT THE NUMBER OF THE INTERVAL ALONG THE HORIZONTAL AXIS OF    00121
C  THE HISTOGRAM.                                                       00122
      WRITE (6,670) (I,I=5,NP,5)                                        00123
      WRITE (6,680)                                                     00124
   83 CONTINUE                                                          00125
      DO 15 KK=1,9                                                      00126
      DO466 I = 1, NP                                                   00127
      IF(TSUM(I).LE.TESTP(KK).AND.TSUM(I+1).GE.TESTP(KK))GO TO 467      00128
      GO TO 466                                                         00129
  467 IF(TSUM(I+1).NE.TSUM(I)) GO TO 469                                00130
      TT=0.0                                                            00131
      GO TO 465                                                         00132
  469 TT=(TESTP(KK)-TSUM(I))/(TSUM(I+1)-TSUM(I))                        00133
465   IF(I.EQ.NP) GO TO 468                                             00134
      DELP(KK)=TT*(X(I+1)-X(I)) + X(I)                                  00135
      GO TO 466                                                         00136
  468 DELP(KK)=DINF                                                     00137
  466 CONTINUE                                                          00138
      VAL(KK)=DELP(KK)+XNOM                                             00139
   15 CONTINUE                                                          00140
C  THE NEXT THREE WRITE STATEMENTS PRINT OUT THE FIRST, FIFTH, ...,     00141
C  99 TH PERCENTILE STATISTICAL INFORMATION.                            00142
      WRITE(6,471) (TESTP(I),I=1,9)                                     00143
      WRITE(6,472) (DELP(KK),KK=1,9)                                    00144
      WRITE(6,473) (VAL(KK),KK=1,9)                                     00145
  471 FORMAT('0PCT.',9(10X,F4.1))                                       00146
  472 FORMAT('0INT.',9D14.5)                                            00147
  473 FORMAT('0VAL.',9D14.5)                                            00148
      RETURN                                                            00149
  600 FORMAT (1H1,4X,20A4)                                              00150
  620 FORMAT(/5X,' PCT. ',61X,'INTERVAL WRT NOMINAL',4X,'PCT. FREQ.',5X,00151
     2 'SUM'/5X,' FREQ.',50X,5X,'  1  MINUS INF. ',1PE12.4,0P2F12.7)    00152
  610 FORMAT(1H0,4X,2A4,2X,'NOMINAL=',1PE12.4,2X,'MEAN=',1PE12.4,2X,    00153
     2 'SIGMA=',1PE12.4,2X,'SAMPLE=',I6)                                00154
  650 FORMAT (5X,F5.2,1X,50A1,5X,I3,1X,1P2E12.4,0P2F12.7)               00155
  660 FORMAT (5X,F5.2,1X,50A1,5X,I3,1PE13.4,'  PLUS INF. ',0P2F12.7)    00156
  670 FORMAT (5X,6X,20I5)                                               00157
  680 FORMAT (5X,6X, 5X,'I N T E R V A L S')                            00158
      END                                                               00159
C          DATA SET LIST       AT LEVEL 001 AS OF 02/12/79
      SUBROUTINE LIST(N)                                                00001
C                                                                       00002
C                                                                       00003
C     SUBROUTINE LIST (N)                                               00004
C                                                                       00005
C                                                                       00006
C                                                                       00007
C     THE PURPOSE OF LIST IS TO PRINT ON UNIT 6 THE INPUT CARD IMAGES   00008
C         FROM ANY GIVEN UNIT.                                          00009
C                                                                       00010
C     ARGUMENTS IN THE CALLING SEQUENCE ARE DEFINED AS FOLLOWS.         00011
C                                                                       00012
C         ARGUMENT   TYPE    I/O        DEFINITION                      00013
C                                                                       00014
C          N         I*4      I      DATASET REFERENCE NUMBER OF        00015
C                                       INPUT CARDS                     00016
C                                                                       00017
C                                                                       00018
C                                                                       00019
C     LIST IS CALLED BY THE FOLLOWING SUBROUTINE.                       00020
C                                                                       00021
C         MAIN                                                          00022
C                                                                       00023
C                                                                       00024
C                                                                       00025
C                                                                       00026
C     NO SUBROUTINES ARE CALLED BY LIST.                                00027
C                                                                       00028
C                                                                       00029
C                                                                       00030
C     LIST NEITHER USES NOR ALTERS VARIABLES IN COMMON.                 00031
C         ALL INPUT AND OUTPUT IS THROUGH THE CALLING SEQUENCE.         00032
C                                                                       00033
C                                                                       00034
C                                                                       00035
      REAL*8 CARD(10)                                                   00036
      WRITE(6,10) N                                                     00037
   10 FORMAT(1H1,3X,'INPUT CARD IMAGES *** DATA SET REF. NO. ',I2///)   00038
  101 READ(N,11,END=800,ERR=500) CARD                                   00039
   11 FORMAT(10A8)                                                      00040
      WRITE(6,13) CARD                                                  00041
   13 FORMAT(1X,10A8)                                                   00042
      GO TO 101                                                         00043
  500 WRITE(6,12)                                                       00044
   12 FORMAT(///5X,'INPUT ERROR',///)                                   00045
  800 REWIND N                                                          00046
      RETURN                                                            00047
      END                                                               00048
C          DATA SET MINDVH     AT LEVEL 003 AS OF 06/25/79
C          DATA SET MINDVH     AT LEVEL 002 AS OF 05/18/79              00001
      SUBROUTINE MINDVH(H,R,V,DELV,ALBEG,ALEND,DAL,XMU,DV,FPA,          00002
     .TII,TNN)                                                          00003
C     H     - UNIT ANGULAR MOMENTUM VECTOR OF THE TARGET ORBIT - I      00004
C     R     - INITIAL POSITION VECTOR OF THE TARGET ORBIT - I           00005
C     V     - INITIAL VELOCITY VECTOR OF THE TARGET ORBIT - I           00006
C     DELV  - DELTA-VEL. REQ. FOR TRANSFER TO TARGET ORBIT - I          00007
C     ALBEG - STARTING VALUE FOR ALPHA ANGLE FOR SCAN (IGUID=3) - I     00008
C     ALEND - ENDING VALUE FOR ALPHA ANGLE FOR SCAN (IGUID=3)-I         00009
C     DAL   - INCREMENTAL VALUE OF ALPHA ANGLE FOR SCAN - I             00010
C     XMU   - GRAVITATIONAL CONSTANT - I                                00011
C     ISCFLG- PRINT OPTION FOR  IGUID=3 - I                             00012
C     DV    - DELTA VELOCITY TO ACHIEVE DESIRED TARGET ORBIT -I)        00013
C     FPA   - IOMPUTED FLIGHT PATH ANGLE I/O                            00014
C     TII   - TARGETED INCLINATION -I                                   00015
C     TNN   - TARGETED NODE -I                                          00016
C                                                                       00017
C                                                                       00018
C     SUBROUTINE MINDVH(H,R,V,DELV,ALBEG,ALEND,DAL,XMU,DV,FPA,T11,TWN)  00019
C                                                                       00020
C                                                                       00021
C                                                                       00022
C  THE PURPOSE OF MINDVH IS TO DETERMINE THE OPTIMUM ATTITUDE FOR       00023
C  THE DELTA VELOCITY AT INJECTION INTO THE INITIAL TARGET ORBIT        00024
C  SUCH THAT THE DELTA VELOCITY AT INJECTION INTO THE DESIRED           00025
C  TARGET ORBIT IS MINIMIZED.                                           00026
C                                                                       00027
C                                                                       00028
C                                                                       00029
C     ARGUMENTS IN THE CALLING SEQUENCE ARE DEFINED AS FOLLOWS.         00030
C                                                                       00031
C         ARGUMENT   TYPE    I/O        DEFINITION                      00032
C                                                                       00033
C          H(3)      R*8      I      UNIT ANGULAR MOMENTUM VECTOR OF    00034
C                                       THE TARGET ORBIT                00035
C          R(3)      R*8      I      INITIAL POSITION VECTOR OF THE     00036
C                                       TARGET ORBIT                    00037
C          V(3)      R*8      I      INITIAL VELOCITY VECTOR OF THE     00038
C                                       TARGET ORBIT                    00039
C          DELV      R*8      I      DELTA VELOCITY REQUIRED FOR        00040
C                                       INJECTION INTO THE TARGET ORBIT 00041
C                                       FROM THE TRANSFER ORBIT         00042
C          ALBEG     R*8      I      STARTING VALUE FOR ALPHA ANGLE FOR 00043
C                                       SCAN(IGUID=3)                   00044
C          ALEND     R*8      I      ENDING VALUE FOR ALPHA ANGLE FOR   00045
C                                       SCAN (IGUIDE=3)                 00046
C          DAL       R*8      I      INCREMENT VALUE OF ALPHA ANGE FOR  00047
C                                       SCAN                            00048
C          XMU       R*8      I      GRAVITATIONAL CONSTANT             00049
C          ISCFLAG   I*4      I      PRINT OPTION FOR IGUIDE=3          00050
C          DV(3)     R*8      O      DELTA VELOCITY TO ACHIEVE DESIRED  00051
C                                       TARGET ORBIT                    00052
C          FPA       R*8      O      FLIGHT PATH ANGLE                  00053
C          TII       R*8      I      TARGETED INCLINATION               00054
C          TNN       R*8      I      TARGETED NODE                      00055
C                                                                       00056
C                                                                       00057
C                                                                       00058
C     MINDVH IS CALLED BY THE FOLLOWING SUBROUTINES.                    00059
C                                                                       00060
C         PREP                                                          00061
C                                                                       00062
C                                                                       00063
C                                                                       00064
C     THE FOLLOWING SUBROUTINES ARE CALLED BY MINDVH.                   00065
C                                                                       00066
C        CROSS      FINDV          UCROSS       ORB                     00067
C                                                                       00068
C                                                                       00069
C                                                                       00070
C     THE FOLLOWING FUNCTION SUBPROGRAMS ARE CALLED BY MINDVH.          00071
C                                                                       00072
C        DOT        FNORM                                               00073
C                                                                       00074
C                                                                       00075
C                                                                       00076
C     THE VARIABLES APPEARING IN COMMON BLOCKS ARE TABULATED BELOW.     00077
C                                                                       00078
C        COMMON VARIABLES USED                                          00079
C                                                                       00080
C        DR         ISCFLG    P1        R2D       S2LB                  00081
C                                                                       00082
C        COMMON VARIABLES USED AND COMPUTED.                            00083
C                                                                       00084
C        AE         AS                                                  00085
C                                                                       00086
C                                                                       00087
C                                                                       00088
      IMPLICIT REAL*8(A-H,O-Z)                                          00089
      DIMENSION H(3),V(3),R(3),DV(3),HR(3),XP(3),YP(3),ZP(3),HU(3),     00090
     1   VU(3),DVP(3),VPL(3)                                            00091
      DIMENSION XI(6),FXI(6),IC(6),EB(6)                                00092
      COMMON/CONST/S2LB,DR,PI,R2D,F2KM,XKM2F,GO                         00093
      COMMON /GEO/ AINSYI,AINTRI,AIS,ALAMDI,ANOM,AP,AS,ASM,             00094
     1 DELNOI,DRTOL,DSMA,DVINI,DVNI,                                    00095
     2EL(6),ES,ESM,SDAY,SNODE,STAFI,TCOV,TAMAN,                         00096
     3 TERR,TUB,WAH,XB(6),XISPH,XISPI,DIS,FIS,DNS,FNS,ALI,ALF,ALD,      00097
     4 IGUIDI,IOP,IW,LEG,IFLAG,ITOPT,ISCFLG                             00098
      COMMON/LUS/LU8,LU9,LU16,LU20                                      00099
C                                                                       00100
      DATA ICOUNT/0/                                                    00101
      DVMIN=1.D+9                                                       00102
      TPI=2.D0*PI                                                       00103
      ICTEST=0                                                          00104
      ICFLG=0                                                           00105
      TI=TII*R2D                                                        00106
      TN=TNN*R2D                                                        00107
      ISFLGI=ISCFLG                                                     00108
      IF(TN.LT.0.D0) TN=TN + TPI*R2D                                    00109
      IF(ISCFLG.LT.1.AND.ISCFLG.NE.-1) GO TO 400                        00110
      ICOUNT=ICOUNT + 1                                                 00111
      WRITE(LU8,25) ICOUNT,TI,TN                                        00112
   25 FORMAT('1',30X,'ABM ATTITUDE OPTIMIZATION SCAN',/,                00113
     . 39X,'CASE NO.',I4,//,70X,'TARGET INCLINATION=',                  00114
     . F6.3,/,70X,'TARGET NODE=',F8.3//)                                00115
      WRITE(LU8,80)                                                     00116
   80 FORMAT(3X,'ALPHA',7X,'FPA',7X,'RA',8X,'DEC',                      00117
     . 6X,'SMA',7X,'ECC',5X,'PERIOD',4X,'DRIFT+W',                      00118
     .4X,'DVTOT',6X,'  INC ',4X,' NODE ',4X,' ARGP ',4X,'  TA  ',/,3X,  00119
     .'(DEG)',6X,'(DEG)',5X,'(DEG)',5X,                                 00120
     .'(DEG)',5X,'(KM)',5X,'(N/A)',5X,'(DY)',4X,                        00121
     . '(DEG)/DY)',2X,'(M/SEC)',5X,'(DEG)',3(5X,'(DEG)')/)              00122
  400 CONTINUE                                                          00123
      XI(1)=ALBEG                                                       00124
      XI(2)=ALBEG                                                       00125
      XI(3)=ALEND                                                       00126
      FXI(2)=.0001D0                                                    00127
      FXI(3)=DAL                                                        00128
      DDAL=DAL                                                          00129
      IC(1)=-1                                                          00130
      IC(2)=100                                                         00131
      IC(4)=1                                                           00132
   20 CONTINUE                                                          00133
      ALPHA=ALBEG*DR                                                    00134
C     COMPUTE SCAN COORDINATE SYSTEM                                    00135
      VMAG=FNORM(V)                                                     00136
      HMAG=FNORM(H)                                                     00137
      DO 101 M=1,3                                                      00138
      VU(M)=V(M)/VMAG                                                   00139
      HU(M)=H(M)/HMAG                                                   00140
  101 CONTINUE                                                          00141
      CALL UCROSS(HU,VU,YP)                                             00142
      DO 105 JA=1,3                                                     00143
      ZP(JA)=HU(JA)                                                     00144
  105 CONTINUE                                                          00145
      CALL UCROSS(YP,HU,XP)                                             00146
      VZ=DOT(V,ZP)                                                      00147
C     COMPUTE CONE ANGLE (THETA)                                        00148
      THETA=DARCOS(DABS(VZ)/DELV)                                       00149
      XX=DELV*DSIN(THETA)                                               00150
C     COMPUTE ABM DELTA VELOCITY VECTOR (DVP)                           00151
      DVP(1)=XX*DCOS(ALPHA)                                             00152
      DVP(2)=XX*DSIN(ALPHA)                                             00153
      DVP(3)=DELV*DCOS(THETA)*DSIGN(1.D0,-VZ)                           00154
      DO 110 K=1,3                                                      00155
      DV(K)=XP(K)*DVP(1)+YP(K)*DVP(2)+ZP(K)*DVP(3)                      00156
  110 CONTINUE                                                          00157
C     COMPUTE RIGHT ASCENSION AND DECLINATION OF SPIN AXIS              00158
      IF (DV(1).NE.0.)GO TO 115                                         00159
      IF(DV(2).GT.0.)RA=0.                                              00160
      IF(DV(2).LT.0) RA=180.D0*DR                                       00161
      GO TO 120                                                         00162
  115 RA=DATAN2(DV(2),DV(1))                                            00163
  120 IF(RA.LT.0.)RA=RA+TPI                                             00164
      DEC=DARSIN(DV(3)/DELV)                                            00165
      RA=RA/DR                                                          00166
      DEC=DEC/DR                                                        00167
      ALPHA=ALPHA/DR                                                    00168
      DO 301 I=1,3                                                      00169
      VPL(I)=V(I)+DV(I)                                                 00170
  301 CONTINUE                                                          00171
C     COMPUTE RESULTING ANGULAR MOMENTUM (HR)                           00172
      CALL CROSS(R,VPL,HR)                                              00173
      HRR=FNORM(HR)                                                     00174
C                                                                       00175
      RM=FNORM(R)                                                       00176
      VM=FNORM(VPL)                                                     00177
      CALL ORB(R,VPL,XMU,EB)                                            00178
C     COMPUTE RESULTING SEMI-MAJOR AXIS (A) AND DRIFT RATE (DLAM)       00179
      SP=(HRR**2)/XMU                                                   00180
      A=1.D0/(2.D0/RM-(VM**2)/XMU)                                      00181
      E = DSQRT(DABS(1.D0-SP/A))                                        00182
      P =(DSQRT(A**3) * 2.D0 *PI)/(DSQRT(XMU) * 86400.D0)               00183
      DLAM=(360.D0/P)-360.9856472D0                                     00184
      DLAM=-DLAM                                                        00185
C   COMPUTE FLIGHT PATH ANGLE                                           00186
      FPA=90.D0 - DARCOS(DOT(R,VPL)/(RM*VM))*R2D                        00187
C     COMPUTE DELTA VELOCITY TO ACQUIRE STATION                         00188
      ES1=ES                                                            00189
      IF(AS.LE.0.D0)AS=A                                                00190
      AS1=AS                                                            00191
C  COMPUTE OPTIMUM MANEUVER POINT(APOGEE OR PERIGEE OF INITIAL          00192
C  ORBIT AND DESIRED ORBIT)                                             00193
      RAP=DABS(A*(1.D0 + E))                                            00194
      RP= DABS(A*(1.D0-E))                                              00195
      IF(ES.GT.0.D0)GOTO310                                             00196
      EE=DABS(RP/AS-1.D0)                                               00197
      IF(EE.GT.DABS(ES1))ES=DABS(ES1)                                   00198
 310  CONTINUE                                                          00199
      RAS=AS*(1.D0+DABS(ES))                                            00200
      RPS=AS*(1.D0-DABS(ES))                                            00201
      VAS = DSQRT(XMU*(2.D0/RAS-1.D0/AS))                               00202
      VPS = DSQRT(XMU*(2.D0/RPS-1.D0/AS))                               00203
      ANA = (RAP+RPS)/2.D0                                              00204
      ANP = (RP+RAS)/2.D0                                               00205
      VA  = DSQRT(XMU*(2.D0/RAP-1.D0/A ))                               00206
      VP  = DSQRT(XMU*(2.D0/RP-1.D0/A ))                                00207
      VAN1 = DSQRT(XMU*(2.D0/RAP-1.D0/ANA))                             00208
      VPN1 = DSQRT(XMU*(2.D0/RP-1.D0/ANP))                              00209
      VAN2 = DSQRT(XMU*(2.D0/RPS-1.D0/ANA))                             00210
      VPN3=DSQRT(XMU*(2.D0/RP-1.D0/AS))                                 00211
      VPN2 = DSQRT(XMU*(2.D0/RAS-1.D0/ANP))                             00212
      DVA1 = DABS(VAN1-VA)                                              00213
      DVA2 = DABS(VAN2-VPS)                                             00214
      DVP1 = DABS(VPN1-VP)                                              00215
      DVP2 = DABS(VPN2-VAS)                                             00216
      DVP3=DABS(VPN3-VP)                                                00217
      DVH=DMIN1(DVA1 + DVA2,DVP1 + DVP2)                                00218
      IF(ES.LT.0.D0)DVH=DVP3                                            00219
      ES=ES1                                                            00220
      AS=AS1                                                            00221
      DVQ=DVH*1000.D0                                                   00222
C     SELECT FROM TABLE MINIMUM DELTA VELOCITY                          00223
      IF(DVH.LT.DVMIN)DVMIN=DVH                                         00224
      IF(ISCFLG.EQ.0.OR.ISCFLG.EQ.-2)  GO TO 200                        00225
      WRITE(LU8,70)ALPHA,FPA,RA,DEC,A,E,P,DLAM,DVQ,EB(3),EB(4),EB(5),   00226
     . EB(6)                                                            00227
   70 FORMAT(1X,F7.3,2(3X,F8.3),3X,F7.3,3X,F7.1,3X,F6.5,                00228
     1 3X,F7.5,6(3X,F7.2))                                              00229
  200 CONTINUE                                                          00230
      IF(ISCFLG.GT.0) GO TO 430                                         00231
      IF(ICTEST.EQ.0) GO TO 420                                         00232
      GO TO (410,420,415,450),ICTEST                                    00233
  420 FXI(1)=DVQ                                                        00234
C  FIND THE MINIMUM FOR FXI                                             00235
      CALL FINDV(XI,FXI,IC)                                             00236
      IF(ICFLG.EQ.1) GO TO 425                                          00237
      IF(IC(5).NE.2) GO TO 425                                          00238
      ICFLG=1                                                           00239
      XI(1)=XI(4)-DDAL                                                  00240
      ALPHA=XI(1)*DR                                                    00241
      FXI(3)=DDAL/10.D0                                                 00242
      IC(1)=-1                                                          00243
      GO TO 105                                                         00244
  425 CONTINUE                                                          00245
      ALPHA=XI(1) *DR                                                   00246
      IF(IC(1).EQ.0) GO TO 105                                          00247
      ICTEST=ICTEST + 1                                                 00248
      GO TO 105                                                         00249
  410 XI(1)=ALEND                                                       00250
      FXI(3)=-DAL                                                       00251
      DDAL=-DDAL                                                        00252
      IC(1)=-1                                                          00253
      IC(4)=1                                                           00254
      ICTEST=2                                                          00255
      DVQ1=DVQ                                                          00256
      ALPHA1=ALPHA*DR                                                   00257
      ALPHA=XI(1)*DR                                                    00258
      ICFLG=0                                                           00259
      GO TO 105                                                         00260
  415  IF(DVQ.LE.DVQ1) GO TO 450                                        00261
      ALPHA=ALPHA1                                                      00262
      ICTEST=4                                                          00263
      GO TO 105                                                         00264
  430 CONTINUE                                                          00265
      IF(ALPHA.GT.ALEND) GO TO 440                                      00266
      ALPHA = (ALPHA + DAL)*DR                                          00267
      GO TO 105                                                         00268
  440 CONTINUE                                                          00269
      WRITE(LU8,75)                                                     00270
   75 FORMAT('0',40X,'OPTIMUM ATTITUDE',/)                              00271
      ISCFLG=-1                                                         00272
      IF(ISFLGI.EQ.1) ISCFLG=-2                                         00273
      GO TO 400                                                         00274
  450 CONTINUE                                                          00275
      ISCFLG=ISFLGI                                                     00276
      IF(ISCFLG.EQ.1)WRITE(LU8,70)XI(1),FPA,RA,DEC,A,E,P,DLAM,DVQ,      00277
     .EB(3),EB(4),EB(5),EB(6)                                           00278
      RETURN                                                            00279
      END                                                               00280
C          DATA SET MISS       AT LEVEL 003 AS OF 06/22/79
C          DATA SET MISS       AT LEVEL 002 AS OF 05/30/79              00001
C          DATA SET MISS       AT LEVEL 001 AS OF 04/04/78              00002
      SUBROUTINE MISS (X,V,XT,VT,XMU,XM,VM,DT)                          00003
C                                                                       00004
C                                                                       00005
C  SUBROUTINE MISS (X,V,XT,VT,XMU,XM,VM,DT)                             00006
C                                                                       00007
C  THE PURPOSE OF MISS IS TO COMPUTE THE DIFFERENCES BETWEEN THE        00008
C  TARGETED AND ACHIEVED POSITIONS AND VELOCITY, THE ERROR IN TIME,     00009
C  AND THE POSITION VECTOR THAT WAS ACTUALLY ACHIEVED, AS PRODUCED      00010
C  BY THE PERTURBING INFLUENCE OF A PARENT OBJECT                       00011
C                                                                       00012
C  ARGUMENTS IN THE CALLING SEQUENCE ARE DEFINED AS FOLLOWS:            00013
C                                                                       00014
C  ARGUMENT  TYPE  I/O    DEFINITION                                    00015
C                                                                       00016
C     X      R*8    I     INITIAL POSITION VECTOR                       00017
C     Y      R*8    I     INITIAL VELOCITY VECTOR                       00018
C     XT     R*8   I/O    TARGET POSITION VECTOR                        00019
C     VT     R*8    I     TARGET VELOCITY VECTOR                        00020
C     XMU    R*8    I     GRAVITATIONAL CONSTANT FOR THE                00021
C                         PERTURBING BODY                               00022
C     XM     R*8    O     NOMINAL MISS VECTOR ERROR                     00023
C     VM     R*8    O     TOTAL DELTA-V ERROR                           00024
C     DT     R*8    O     ERROR IN TIME                                 00025
C                                                                       00026
C  MISS IS CALLED BY THE FOLLOWING SUBROUTINE:                          00027
C                                                                       00028
C     MODE2                                                             00029
C                                                                       00030
C  THE FOLLOWING SUBPROGRAMS ARE CALLED BY MISS:                        00031
C                                                                       00032
C     DOT    FNORM                                                      00033
C                                                                       00034
C  MISS NEITHER USES NOR ALTERS VARIABLES IN COMMON.  ALL INPUT         00035
C  AND OUTPUT IS THROUGH THE CALLING SEQUENCE.                          00036
      IMPLICIT REAL*8(A-H,O-Z)                                          00037
      DIMENSION X(3),V(3),XT(3),VT(3),XM(3),XB(3),VB(3),AB(3)           00038
      DIMENSION VM(3)                                                   00039
      XN = FNORM(X)                                                     00040
      XTN = FNORM(XT)                                                   00041
      DO 10 I = 1,3                                                     00042
      XB(I) = X(I)-XT(I)                                                00043
      VB(I) = V(I)-VT(I)                                                00044
C  COMPUTE THE DELTA-G BETWEEN THE INITIAL AND TARGET POSITIONS, WHERE  00045
C  G IS THE ACCELERATION DUE TO GRAVITY                                 00046
      AB(I) = -XMU*(X(I)/XN**3-XT(I)/XTN**3)                            00047
   10 CONTINUE                                                          00048
      DT = -DOT(XB,VB)/DOT(VB,VB)                                       00049
      DO 20 I = 1,3                                                     00050
C  COMPUTE THE NOMINAL MISS VECTOR                                      00051
      XM(I) = XB(I)+VB(I)*DT+AB(I)*DT**2/2.D0                           00052
C  COMPUTE THE DELTA-V DIFFERENCE BETWEEN THE INITIAL AND FINAL         00053
C  VELOCITIES                                                           00054
      VM(I) = VB(I)+DT*AB(I)                                            00055
C  COMPUTE THE FINAL TARGET POSITION VECTOR                             00056
      XT(I) = XT(I)+VT(I)*DT-XMU*XT(I)/XTN**3*DT**2/2.D0                00057
   20 CONTINUE                                                          00058
      RETURN                                                            00059
      END                                                               00060
C          DATA SET MODE2      AT LEVEL 003 AS OF 06/27/79
C          DATA SET MODE2      AT LEVEL 002 AS OF 05/31/79              00001
C          DATA SET MODE2      AT LEVEL 001 AS OF 04/04/78              00002
      SUBROUTINE MODE2 (X,XT,ET,EVT,ET2,EVT2,ET3,EVT3,ETK,EVTK,ETE,EVTE,00003
     2  SB,DT2,DT3,DT4,TF,OUT,XMU,X2)                                   00004
C                                                                       00005
C                                                                       00006
C  SUBROUTINE MODE2 (X,XT,ET,EVT,ET2,EVT2,ET3,EVT3,ETK,EVTK,ETE,EVTE,   00007
C  2  SB,DT2,DT3,DT4,TF,OUT,XMU,X2)                                     00008
C                                                                       00009
C  THE PURPOSE OF MODE2 IS TO SIMULATE A MISSION FROM THE INITIAL       00010
C  ORBIT TO THE TARGET ENCOUNTER                                        00011
C                                                                       00012
C  ARGUMENTS IN THE CALLING SEQUENCE ARE DEFINED AS FOLLOWS:            00013
C                                                                       00014
C  ARGUMENT  TYPE  I/O    DEFINITION                                    00015
C                                                                       00016
C     X      R*8    I    INITIAL STATE VECTOR                           00017
C     XT     R*8    I    TARGET STATE VECTOR                            00018
C     ET     R*8    I    CORRELATION EIGENVALUES FOR TARGET 1 ERRORS    00019
C     EVT    R*8    I    CORRELATION MATRIX FOR TARGET 1 ERRORS         00020
C     ET2    R*8    I    CORRELATION EIGENVALUES FOR TARGET 2 ERRORS    00021
C     EVT2   R*8    I    CORRELATION MATRIX FOR TARGET 2 ERRORS         00022
C     ET3    R*8    I    CORRELATION EIGENVALUES FOR TARGET 3 ERRORS    00023
C     EVT3   R*8    I    CORRELATION MATRIX FOR TARGET 3 ERRORS         00024
C     ETK    R*8    I    CORRELATION EIGENVALUES FOR SPACECRAFT-E ERRORS00025
C     EVTK   R*8    I    CORRELATION MATRIX FOR SPACECRAFT-E ERRORS     00026
C     ETE    R*8    I    CORRELATION EIGENVALUES FOR TARGET-E ERRORS    00027
C     EVTE   R*8    I    CORRELATION MATRIX FOR TARGET-E ERRORS         00028
C     SB     R*8    I    1-SIGMA ERRORS FOR THRUST, PITCH, AND YAW      00029
C     DT2    R*8    I     (DT2, DT3, AND DT4 ARE TIME INCREMENTS TO     00030
C     DT3    R*8    I      BE SPECIFIED DEPENDING ON THE DESIRED        00031
C     DT4    R*8    I      MANEUVER SEQUENCE)                           00032
C     TF     R*8    I    TF IS THE TIME BETWEEN FIRST BURN AND FINAL    00033
C                        STATE                                          00034
C     OUT    R*8    O    ARRAY CONTAINING TRAJECTORY PARAMETERS         00035
C     XMU    R*8    I    GRAVITATIONAL CONSTANT OF THE PARENT BODY      00036
C     X2     R*8    O    OUTPUT STATE VECTOR WITH ERRORS                00037
C                                                                       00038
C  MODE2 IS CALLED BY THE FOLLOWING SUBROUTINE:                         00039
C                                                                       00040
C    GUIDE                                                              00041
C                                                                       00042
C  MODE2 CALLS THE FOLLOWING SUBPROGRAMS:                               00043
C                                                                       00044
C   ADOT CROSS DOT FNORM MISS RANDOM RANTAR UCROSS                      00045
C                                                                       00046
C  THE VARIABLES APPEARING IN A COMMON BLOCK ARE GIVEN BELOW:           00047
C                                                                       00048
C  COMMON VARIABLES USED:                                               00049
C                                                                       00050
C    IFRN  IKEY                                                         00051
C                                                                       00052
C                                                                       00053
      IMPLICIT REAL*8 (A-H,O-Y)                                         00054
      REAL*8 NAMES,Z                                                    00055
      COMMON /GENRL/ P1,PI(6,6),XII(6),XXMU,NAMES(6),PITCHI,YAWI,WI,    00056
     A P1I(6,6),P2I(6,6),P3I(6,6),P4I(6,6),P5I(6,6),P6I(6,6),TOLR(25),  00057
     * THRUSI,SIGBI(3),ZDELT,ZUB(3,25),                                 00058
     B IP1COR,IP2COR,IP3COR,IP4COR,IP5COR,IP6COR,                       00059
     1 ICOV(25),IHIST(25),IPCOOR,ITPSTR,NCONF,MODE                      00060
     2 ,IKEY,IFRN                                                       00061
      COMMON /INPUT/ AINPUT(20)                                         00062
      DIMENSION XP(3),XR(3)                                             00063
      DIMENSION X(6),XT(6),ET(6),EVT(6,6),ETE(6),EVTE(6,6),SB(3),OUT(6),00064
     2  X2(6),XTR(6),XM(3),XTE(6)                                       00065
      DIMENSION S(3),Z(3),T(3),R(3)                                     00066
      DIMENSION XN(3)                                                   00067
      DIMENSION EVT2(6,6),ET2(6),EVT3(6,6),ET3(6),EVTK(6,6),ETK(6)      00068
      DATA Z/0.D0,0.D0,1.D0/                                            00069
      DO 10 I = 1,6                                                     00070
      OUT(I) = 0.D0                                                     00071
      X2(I) = X(I)                                                      00072
   10 CONTINUE                                                          00073
      OUT(13) = 0.D0                                                    00074
      IF (DT2.EQ.0.D0) GO TO 50                                         00075
C  THE CALL RANTAR STATEMENTS IN THIS SUBROUTINE CAUSE DELTA-V (OUT(1)- 00076
C  OUT(3) AND OUT(13)), THE ANGLE BETWEEN THE DELTA-V AND ANGULAR       00077
C  MOMENTUM VECTORS (OUT(8)-OUT(10) AND OUT(14), AND THE CHANGED STATE  00078
C  VECTOR (ALWAYS CALLED X2) TO BE CALCULATED                           00079
      CALL RANTAR(X2,XT,TF,SB,OUT(1),DT2,XMU,OUT(8))                    00080
C  COMPUTE THE OUTPUT STATE VECTOR WITH ERRORS, XTR                     00081
   50 CALL RANDOM(EVT,ET,XT,XTR,IKEY,IFRN)                              00082
      IF (DT3.EQ.0.D0) GO TO 100                                        00083
      CALL RANTAR (X2,XTR,TF-DT2,SB,OUT(2),DT3,XMU,OUT(9))              00084
      CALL RANDOM(EVT2,ET2,XTR,XTR,IKEY,IFRN)                           00085
  100 IF (DT4.EQ.0.D0) GO TO 120                                        00086
      CALL RANTAR (X2,XTR,TF-DT2-DT3,SB,OUT(3),DT4,XMU,OUT(10))         00087
      CALL RANDOM(EVT3,ET3,XTR,XTR,IKEY,IFRN)                           00088
  120 CALL RANTAR (X2,XTR,TF-DT2-DT3-DT4,SB,OUT(13),TF-DT2-DT3-DT4,     00089
     2 XMU,OUT(14))                                                     00090
C  COMPUTE THE TOTAL DELTA-V                                            00091
      OUT(4) = OUT(1)+OUT(2)+OUT(3)+OUT(13)                             00092
C  COMPUTE XTE AND X2, THE OUTPUT STATE VECTORS WITH ERRORS FOR USE IN  00093
C  SUBROUTINE MISS                                                      00094
      CALL RANDOM(EVTE,ETE,XTR,XTE,IKEY,IFRN)                           00095
      CALL RANDOM(EVTK,ETK,X2,X2,IKEY,IFRN)                             00096
C  COMPUTE THE NOMINAL MISS VECTOR ERROR (XM), THE TOTAL DELTA-V ERROR  00097
C  (S), DELTA-T (DT), AND THE PERTURBED TARGET POSITION VECTOR (XTE)    00098
      CALL MISS (X2,X2(4),XTE,XTE(4),XMU,XM,S,DT)                       00099
      IF (ET(1)+ETE(1)+SB(1).NE.0.D0) GO TO 150                         00100
      DO 130 I = 1,3                                                    00101
      XN(I) = XM(I)                                                     00102
  130 CONTINUE                                                          00103
      WRITE (6,600) XN                                                  00104
  150 DO 160 I = 1,3                                                    00105
      XM(I) = XM(I)-XN(I)                                               00106
  160 CONTINUE                                                          00107
      OUT(5) = FNORM(XM)                                                00108
      OUT(6) = DOT(XM,XTE(1))/FNORM(XTE(1))                             00109
      OUT(7) = DT                                                       00110
      SN = FNORM(S)                                                     00111
C  COMPUTE THE COMPONENTS OF THE DELTA-V UNIT VECTOR                    00112
      DO 210 I = 1,3                                                    00113
      S(I) = S(I)/SN                                                    00114
  210 CONTINUE                                                          00115
C  THE UNIT VECTOR, T, LIES IN THE X,Y PLANE SINCE Z HAS COMPONENTS     00116
C  (0,0,1)                                                              00117
      CALL UCROSS (S,Z,T)                                               00118
      CALL CROSS (S,T,R)                                                00119
      OUT(11) = DOT(XM,T)                                               00120
      OUT(12) = DOT(XM,R)                                               00121
      OUT(21) = DSQRT((OUT(11)-AINPUT(1))**2+(OUT(12)-AINPUT(2))**2)    00122
      OUT(22) = DSQRT((OUT(11)-AINPUT(3))**2+(OUT(12)-AINPUT(4))**2)    00123
      OUT(23)= ADOT(XM,XTE)                                             00124
      DO 220 I = 1,3                                                    00125
      XR(I) = T(I)*(OUT(11)-AINPUT(1))+R(I)*(OUT(12)-AINPUT(2))         00126
      XP(I) = T(I)*(OUT(11)-AINPUT(3))+R(I)*(OUT(12)-AINPUT(4))         00127
  220 CONTINUE                                                          00128
      OUT(24) = ADOT(XR,XTE)                                            00129
      OUT(25) = ADOT(XP,XTE)                                            00130
      RETURN                                                            00131
  600 FORMAT (/5X,'NOMINAL MISS VECTOR ERROR',3D21.13)                  00132
      END                                                               00133
C          DATA SET MTRPLY     AT LEVEL 002 AS OF 06/01/79
C                                                                       00001
      SUBROUTINE MTRPLY (A,B,C,NRA, NCA, NCB, NA,NB,NC)                 00002
C                                                                       00003
C                                                                       00004
C     SUBROUTINE MTRPLY (A,B,C,NRA,NCA,NCB,NA,NB,NC)                    00005
C                                                                       00006
C                                                                       00007
C                                                                       00008
C     THE PURPOSE OF MTRPLY IS TO MULTIPLY TWO MATRICES, A AND B.       00009
C                                                                       00010
C                                                                       00011
C                                                                       00012
C     ARGUMENTS IN THE CALLING SEQUENCE ARE DEFINED AS FOLLOWS.         00013
C                                                                       00014
C         ARGUMENT   TYPE    I/O        DEFINITION                      00015
C                                                                       00016
C         A(NA,1)    R*8      I      FIRST MATRIX TO BE MULTIPLIED      00017
C         B(NB,1)    R*8      I      SECOND MATRIX TO BE MULTIPLIED     00018
C         C(NC,1)    R*8      O      PRODUCT OF A AND B MATRICIES       00019
C         NRA        I*4      I      NUMBER OF ROWS IN MATRIX A         00020
C         NCA        I*4      I      NUMBER OF COLUMNS IN MATRIX A      00021
C         NCB        I*4      I      NUMBER OF COLUMNS IN MATRIX B      00022
C         NA         I*4      I      DIMENSION OF ARRAY A               00023
C         NB         I*4      I      DIMENSION OF ARRAY B               00024
C         NC         I*4      I      DIMENSION OF ARRAY C               00025
C                                                                       00026
C                                                                       00027
C                                                                       00028
C     MTRPLY IS CALLED BY THE FOLLOWING SUBROUTINES.                    00029
C                                                                       00030
C         CVPROP    RANDOM      RANTAR                                  00031
C                                                                       00032
C                                                                       00033
C                                                                       00034
C     NO SUBROUTINES ARE CALLED BY MTRPLY.                              00035
C                                                                       00036
C                                                                       00037
C                                                                       00038
C     MTRPLY NEITHER USES NOR ALTERS VARIABLES IN COMMON. ALL           00039
C         INPUT AND OUTPUT IS THROUGH THE CALLING SEQUENCE.             00040
C                                                                       00041
C                                                                       00042
C                                                                       00043
C                                                                       00044
      IMPLICIT REAL*8(A-H,O-Z)                                          00045
      DOUBLE PRECISION A(NA,1), B(NB,1), C(NC,1)                        00046
      DO 1 I=1,NRA                                                      00047
      DO 1 J=1,NCB                                                      00048
      C(I,J) = 0.D0                                                     00049
      DO 1 K=1,NCA                                                      00050
      C(I,J) = C(I,J) + A(I,K)*B(K,J)                                   00051
    1 CONTINUE                                                          00052
      RETURN                                                            00053
      END                                                               00054
C          DATA SET MTRX       AT LEVEL 002 AS OF 06/19/79
C          DATA SET MTRX       AT LEVEL 001 AS OF 04/04/78              00001
C                                                                       00002
      SUBROUTINE MTRX(A,B,Q,NR,NC,M)                                    00003
C                                                                       00004
C                                                                       00005
C     SUBROUTINE MTRX (A,B,Q,NR,NC,M)                                   00006
C                                                                       00007
C                                                                       00008
C                                                                       00009
C     THE PURPOSE OF MTRX IS TO PERFORM MATRIX OPERATIONS OF THE FORM   00010
C         Q=AB AND Q=ABATRANSPOSE.                                      00011
C                                                                       00012
C                                                                       00013
C                                                                       00014
C     ARGUMENTS IN THE CALLING SEQUENCE ARE DEFINED AS FOLLOWS.         00015
C                                                                       00016
C         ARGUMENT   TYPE    I/O        DEFINITION                      00017
C                                                                       00018
C          A(6,6)    R*16     I      INPUT MATRIX                       00019
C          B(NR,NC)  R*16     I      INPUT MATRIX                       00020
C          Q(6,6)    R*16     O      RESULTANT MATRIX                   00021
C          NR        I*4      I      NUMBER OF ROWS IN B MATRIX         00022
C          NC        I*4      I      NUMBER OF COLUMNS IN B MATRIX      00023
C          M         I*4      I      OPTION FLAG                        00024
C                                       =0,Q=AB                         00025
C                                       =-1,Q=ABATRANSPOSE              00026
C                                                                       00027
C                                                                       00028
C                                                                       00029
C     MTRX IS CALLED BY THE FOLLOWING SUBROUTINES.                      00030
C                                                                       00031
C         CONVET    CVPROP                                              00032
C                                                                       00033
C                                                                       00034
C                                                                       00035
C     NO SUBROUTINES ARE CALLED BY MTRX.                                00036
C                                                                       00037
C                                                                       00038
C                                                                       00039
C     MTRX NEITHER USES NOR ALTERS VARIABLES IN COMMON. ALL INPUT AND   00040
C         OUTPUT IS THROUGH THE CALLING SEQUENCE.                       00041
C                                                                       00042
C                                                                       00043
C                                                                       00044
C                                                                       00045
      IMPLICIT REAL*8(A-H,O-Z)                                          00046
      DOUBLE PRECISION A,B,C,D,Q                                        00047
      DIMENSION A(6,6),B(NR,NC),C(6,6),D(6),Q(6,6)                      00048
C     M=0  GIVES Q=AB                                                   00049
C     M=-1 GIVES Q=ABATRANSPOSE                                         00050
      DO 7 I=1,6                                                        00051
C  COMPUTE THE PRODUCT OF MATRICES A AND B, IN THE DO 1 DO LOOP         00052
      DO 1 J=1,NC                                                       00053
      D(J)=0.D0                                                         00054
      DO 1 K=1,NR                                                       00055
1     D(J)=D(J)+A(I,K)*B(K,J)                                           00056
      IF(M) 4,2,4                                                       00057
2     CONTINUE                                                          00058
      DO 3 J=1,NC                                                       00059
3     C(I,J)=D(J)                                                       00060
      GO TO 7                                                           00061
C  COMPUTE ABA TRANSPOSE                                                00062
4     DO 5 J=1,6                                                        00063
      C(I,J)=0.D0                                                       00064
      DO 5 K=1,NC                                                       00065
5     C(I,J)=C(I,J)+D(K)*A(J,K)                                         00066
7     CONTINUE                                                          00067
      DO 8 I=1,6                                                        00068
      DO 8 J=1,6                                                        00069
8     Q(I,J)=C(I,J)                                                     00070
      RETURN                                                            00071
      END                                                               00072
C          DATA SET MTXPR      AT LEVEL 004 AS OF 06/22/79
C          DATA SET MTXPR      AT LEVEL 003 AS OF 06/01/79              00001
      SUBROUTINE MTXPR(X,P,E,EV,XMU)                                    00002
C                                                                       00003
C                                                                       00004
C     SUBROUTINE MTXPR (X,P,E,EV,XMU)                                   00005
C                                                                       00006
C                                                                       00007
C                                                                       00008
C     THE PURPOSE OF MTXPR IS TO FIND THE CORRELATION                   00009
C         EIGENVALUES AND MATRIX FOR A COVARIANCE MATRIX.               00010
C                                                                       00011
C                                                                       00012
C                                                                       00013
C     ARGUMENTS IN THE CALLING SEQUENCE ARE DEFINED AS FOLLOWS.         00014
C                                                                       00015
C         ARGUMENT   TYPE    I/O        DEFINITION                      00016
C                                                                       00017
C          X(6)      R*8      I      STATE VECTOR                       00018
C          P(6,6)    R*8      I      COVARIANCE MATRIX IN               00019
C                                        INERTIAL COORDINATES           00020
C          E(6)      R*8      O      CORRELATION EIGENVALUES            00021
C          EV(6,6)   R*8      O      CORRELATION MATRIX                 00022
C          XMU       R*8      I      GRAVITATIONAL CONSTANT FACTOR      00023
C                                                                       00024
C                                                                       00025
C                                                                       00026
C     MTXPR IS CALLED BY THE FOLLOWING SUBROUTINES.                     00027
C                                                                       00028
C         CVPROP    GEOS    GEOSY     GUIDE                             00029
C                                                                       00030
C                                                                       00031
C                                                                       00032
C     THE FOLLOWING SUBROUTINES ARE CALLED BY MTXPR.                    00033
C                                                                       00034
C         CONVET    EIGEN     ORB                                       00035
C                                                                       00036
C                                                                       00037
C                                                                       00038
C     THE FOLLOWING FUNCTION SUBPROGRAM IS CALLED BY MTXPR.             00039
C                                                                       00040
C         FNORM                                                         00041
C                                                                       00042
C                                                                       00043
C                                                                       00044
C     MTXPR NEITHER USES NOR ALTERS VARIABLES IN COMMON. ALL INPUT      00045
C         AND OUTPUT IS THROUGH THE CALLING SEQUENCE.                   00046
C                                                                       00047
C                                                                       00048
C                                                                       00049
C                                                                       00050
      IMPLICIT REAL*8(A-H,O-Z)                                          00051
      DIMENSION X(6),P(6,6),E(6),EV(6,6),PX(6,6)                        00052
      DIMENSION B(6,6),EL(6),ELEM(11)                                   00053
      DIMENSION PP(36),S(6),IX(6),QQ(36),RR(6)                          00054
      DATA ELEM/'ECC','SMA','INC','OMEGA','ARGP','THETA','RADIUS',      00055
     1 'VELOCITY','PERIOD','APOGEE','PERIGEE'/                          00056
      DATA PI /3.141592653589893D0/                                     00057
      WRITE (6,600) (X(I),I=1,6)                                        00058
C  CONVET COMPUTES PX, THE COVARIANCE MATRIX TRANSFORMED FROM THE       00059
C  EQUATORIAL TO THE LOCAL TANGENT SYSTEM                               00060
      CALL CONVET(P,X,X(4),0,PX)                                        00061
       IN= 0                                                            00062
      DO 50 I=1,6                                                       00063
      E(I) = 0.D0                                                       00064
      RR(I) = 0.D0                                                      00065
      DO 40 J=1,6                                                       00066
      EV(I,J) = 0.D0                                                    00067
C  .0003048 IS THE CONVERSION FACTOR FROM KM TO FEET.                   00068
      B(I,J) = PX(I,J)/.0003048D0**2                                    00069
   40 CONTINUE                                                          00070
      IF (P(I,I).LE.0.D0) GO TO 50                                      00071
      IN = IN+1                                                         00072
      IX(IN) = I                                                        00073
      S(IN) = DSQRT(P(I,I))                                             00074
   50 CONTINUE                                                          00075
      IF (IN.EQ.0) RETURN                                               00076
      DO 70 J = 1,IN                                                    00077
      JJ = IX(J)                                                        00078
      DO 60 I = 1,IN                                                    00079
      II = IX(I)                                                        00080
      IJ = IN*(J-1)+I                                                   00081
      PP(IJ) = P(II,JJ)/(S(I)*S(J))                                     00082
      QQ(IJ) = P(II,JJ)                                                 00083
   60 CONTINUE                                                          00084
   70 CONTINUE                                                          00085
C  COMPUTE THE EIGENVECTORS (PP) AND EIGENVALUES (E) OF THE INPUT       00086
C  REAL SYMMETRIC MATRIX (PP).                                          00087
      CALL EIGEN (PP,E,IN,1)                                            00088
      DO 90 I = 1,IN                                                    00089
      II = IX(I)                                                        00090
      DO 80 J = 1,IN                                                    00091
      IJ = IN*(J-1)+I                                                   00092
      EV(II,J) = PP(I J)*S(I)                                           00093
   80 CONTINUE                                                          00094
   90 CONTINUE                                                          00095
C  COMPUTE THE EIGENVECTORS (QQ) AND EIGENVALUES (RR)                   00096
      CALL EIGEN (QQ,RR,IN,1)                                           00097
      DO 100 I = 1,6                                                    00098
      S(I) = DSQRT (DMAX1(RR(I),0.D0))                                  00099
  100 CONTINUE                                                          00100
C  CONVERT CARTESIAN TO KEPLERIAN ELEMENTS                              00101
      CALL ORB(X,X(4),XMU,EL)                                           00102
      RXX=FNORM(X)                                                      00103
      VXX=FNORM(X(4))                                                   00104
      PERD=2.D0*PI*EL(2)*DSQRT(DABS(EL(2))/XMU)/86400.D0                00105
      APOR=EL(2)*(1.D0+EL(1))                                           00106
      PERR=EL(2)*(1.D0-EL(1))                                           00107
      WRITE(6,660) (ELEM(I),I=1,6),(EL(I),I=1,6),                       00108
     1 (ELEM(I),I=7,11),RXX,VXX,PERD,APOR,PERR                          00109
      WRITE(6,610) ((PX(I,J),J=1,6),I=1,6)                              00110
      WRITE (6,640) ((B(I,J),J=1,6),I=1,6)                              00111
      WRITE (6,620) ((P(I,J),J=1,6),I=1,6)                              00112
      WRITE (6,650) (RR(I),I=1,6)                                       00113
      WRITE (6,655) S                                                   00114
      WRITE(6,630) (E(I),I=1,6)                                         00115
      RETURN                                                            00116
  600 FORMAT (/5X,12HSTATE VECTOR/(6D21.13))                            00117
  610 FORMAT (/5X,33HCOVARIANCE MATRIX (LOCAL TANGENT)/(6D21.13))       00118
  620 FORMAT (/5X,28HCOVARIANCE MATRIX (INERTIAL)/(6D21.13))            00119
  630 FORMAT (5X,'CORRELATION EIGENVALUES'/(6D21.13))                   00120
  640 FORMAT (/5X,33HCOVARIANCE MATRIX (LOC TAN -- FT)/(6D21.13))       00121
  650 FORMAT (/5X,'EIGENVALUES'/(6D21.13))                              00122
  655 FORMAT (/5X,'SQUARE ROOTS OF EIGENVALUES'/(6D21.13))              00123
  660 FORMAT(/1X,6(13X,A8),/1X,6D21.13,/1X,                             00124
     1 5(13X,A8),/1X,5D21.13)                                           00125
      END                                                               00126
C          DATA SET M2STAT     AT LEVEL 003 AS OF 06/20/79
C          DATA SET M2STAT     AT LEVEL 002 AS OF 10/31/78              00001
      SUBROUTINE M2STAT(LUTP,ICOV,NP,NOPT,ELT)                          00002
C                                                                       00003
C                                                                       00004
C     SUBROUTINE M2STAT (LUTP,ICOV,NP,NOPT,ECT)                         00005
C                                                                       00006
C                                                                       00007
C                                                                       00008
C     THE PURPOSE OF M2STAT IS TO COMPUTE OUTPUT COVARIANCE MATRICES.   00009
C                                                                       00010
C                                                                       00011
C                                                                       00012
C     ARGUMENTS IN THE CALLING SEQUENCE ARE DEFINED AS FOLLOWS.         00013
C                                                                       00014
C         ARGUMENT   TYPE    I/O        DEFINITION                      00015
C                                                                       00016
C          LUTP                      NOT USED                           00017
C          ICOV(20)  I*4      I      OUTPUT COVARIANCE FLAGS            00018
C                                       ICOV(I)=J, WHERE I DEFINES THE  00019
C                                       OUTPUT MATRIX,                  00020
C                                       I=1-6 FOR OUTPUT MATRIX 1,      00021
C                                       I=7-8 FOR OUTPUT MATRIX 2,      00022
C                                       I=9-14 FOR OUTPUT MATRIX 3, AND 00023
C                                       J DEFINES THE OUTPUT STATE      00024
C                                       VARIABLE USED IN THE COVARIANCE 00025
C          NP        I*4      I      STATE VECTOR DIMENSION             00026
C          NOPT                      NOT USED                           00027
C          ELT(25)   R*8      I      INITIAL STATE VECTOR               00028
C                                                                       00029
C                                                                       00030
C                                                                       00031
C     M2STAT IS CALLED FOR BY THE FOLLOWING SUBROUTINES.                00032
C                                                                       00033
C         STATS                                                         00034
C                                                                       00035
C                                                                       00036
C                                                                       00037
C                                                                       00038
C     THE FOLLOWING SUBROUTINE IS CALLED BY M2STAT.                     00039
C                                                                       00040
C         COVAR                                                         00041
C                                                                       00042
C     M2STAT NEITHER USES NOR ALTERS VARIABLES IN COMMON. ALL INPUT AND 00043
C         OUTPUT IS THROUGH THE CALLING SEQUENCE.                       00044
C                                                                       00045
C                                                                       00046
C                                                                       00047
      IMPLICIT REAL*8(A-H,O-Z)                                          00048
      DIMENSION ICOV(20),ELT(50),NCOV(20),VVM(4)                        00049
      DIMENSION EV(6,6),E(6),V(6,6),SD(6),XM(6),XN(50)                  00050
      DO 10 I=1,6                                                       00051
      NCOV(I)=ICOV(I)                                                   00052
       NT=I                                                             00053
      IF(NCOV(I).NE.0) GO TO 10                                         00054
      NT=I-1                                                            00055
      GO TO 11                                                          00056
   10 CONTINUE                                                          00057
   11 IF(NT.EQ.0) GO TO 1000                                            00058
      WRITE(6,100)                                                      00059
C  SUBROUTINE COVAR ENABLES THE FOLLOWING TO BE COMPUTED: THE           00060
C  EIGENVECTORS (EV), EIGENVALUES (E), OUTPUT MEAN COVARIANCE MATRIX    00061
C  WITH RESPECT TO NOMINAL (V), STANDARD DEVIATIONS (SD), MEAN AND      00062
C  NOMINAL STATE VECTORS (XM AND XN).                                   00063
C                                                                       00064
C  COMPUTE OUTPUT MATRIX 1                                              00065
      CALL COVAR(LUTP,ELT,NP,NT,NCOV,1,EV,E,V,SD,XM,XN)                 00066
 1000 NCOV(1)=ICOV(7)                                                   00067
      NCOV(2)=ICOV(8)                                                   00068
      IF((NCOV(1)*NCOV(2)).EQ.0) GO TO 12                               00069
      WRITE(6,101)                                                      00070
C  COMPUTE OUTPUT MATRIX 2                                              00071
      CALL COVAR(LUTP,ELT,NP,2,NCOV,1,EV,E,V,SD,XM,XN)                  00072
      WRITE(6,110)                                                      00073
C  THETA GIVES THE ELLIPSE ORIENTATION ANGLE FOR THE ONE SIGMA ERROR    00074
C  ELLIPSE.                                                             00075
      THETA = DATAN2 (EV(2,1),EV(1,1))*57.2957795131D0                  00076
      WRITE(6,120) THETA                                                00077
  120 FORMAT(/25X,'ELLIPSE ORIENTATION ANGLE(DEG) =',F8.2)              00078
      VVM(1)=EV(1,1)*DSQRT(E(1))                                        00079
      VVM(2)=EV(3,1)*DSQRT(E(2))                                        00080
      VVM(3)=EV(2,1)*DSQRT(E(1))                                        00081
      VVM(4)=EV(4,1)*DSQRT(E(2))                                        00082
      WRITE(6,112) ELT(ICOV(7)),ELT(ICOV(8))                            00083
  112 FORMAT(22X,A8,13X,A8)                                             00084
      WRITE(6,114) VVM(1),VVM(3),VVM(2),VVM(4)                          00085
  114 FORMAT(/,1X,'SEMI-AXIS (1)',2D21.13,/,1X,                         00086
     1 'SEMI-AXIS (2)',2D21.13)                                         00087
   12 CONTINUE                                                          00088
      DO 20 I=1,6                                                       00089
      NCOV(I)=ICOV(I+8)                                                 00090
      NT=I                                                              00091
      IF(NCOV(I).NE.0) GO TO 20                                         00092
      NT=I-1                                                            00093
      GO TO 21                                                          00094
   20 CONTINUE                                                          00095
   21 IF(NT.EQ.0) GO TO 105                                             00096
      WRITE(6,102)                                                      00097
C  COMPUTE OUTPUT MATRIX 3                                              00098
      CALL COVAR(LUTP,ELT,NP,NT,NCOV,0,EV,E,V,SD,XM,XN)                 00099
  100 FORMAT(//25X,'OUTPUT MATRIX 1')                                   00100
C                                                                       00101
  101 FORMAT(//25X,'OUTPUT MATRIX 2')                                   00102
  102 FORMAT(//25X,'OUTPUT MATRIX 3')                                   00103
      GO TO 105                                                         00104
C                                                                       00105
C                                                                       00106
  104 FORMAT(1X,A8,6D20.12)                                             00107
  110 FORMAT(//25X,'ONE-SIGMA ERROR ELLIPSE COORDINATES WRT MEAN')      00108
  105 RETURN                                                            00109
      END                                                               00110
C          DATA SET ORB        AT LEVEL 001 AS OF 04/04/78              00000010
C                                                                       00000020
      SUBROUTINE ORB(X,DX,U,OE)                                         00000030
C                                                                       00000040
C                                                                       00000050
C     SUBROUTINE ORB (X,DX,U,OE)                                        00000060
C                                                                       00000070
C                                                                       00000080
C                                                                       00000090
C     THE PURPOSE OF ORB IS TO CONVERT CARTESIAN ORBITAL ELEMENTS TO    00000100
C         KEPLERIAN ORBITAL ELEMENTS.                                   00000110
C                                                                       00000120
C                                                                       00000130
C                                                                       00000140
C     ARGUMENTS IN THE CALLING SEQUENCE ARE DEFINED AS FOLLOWS.         00000150
C                                                                       00000160
C         ARGUMENT   TYPE    I/O        DEFINITION                      00000170
C                                                                       00000180
C          X(3)      R*8      I      CARTESIAN POSITION VECTOR          00000190
C          DX(3)     R*8      I      CARTESIAN VELOCITY VECTOR          00000200
C          U         R*8      I      GRAVITATIONAL CONSTANT             00000210
C          OE(6)     R*8      O      OUTPUT KEPLERIAN ELEMENTS          00000220
C                                                                       00000230
C                                                                       00000240
C                                                                       00000250
C     ORB IS CALLED BY THE FOLLOWING SUBROUTINES.                       00000260
C                                                                       00000270
C       CVPROP    GEOS      GEOSY     MINDVH   MTXPR                    00000280
C                                                                       00000290
C                                                                       00000300
C                                                                       00000310
C     THE FOLLOWING SUBROUTINES ARE CALLED BY ORB.                      00000320
C                                                                       00000330
C         CROSS     TCONIC                                              00000340
C                                                                       00000350
C                                                                       00000360
C                                                                       00000370
C     THE FOLLOWING FUNCTION SUBPROGRAMS ARE CALLED BY ORB.             00000380
C                                                                       00000390
C         ARKTNS    DOT                                                 00000400
C                                                                       00000410
C                                                                       00000420
C                                                                       00000430
C     THE VARIABLES APPEARING IN COMMON BLOCKS ARE TABULATED BELOW.     00000440
C                                                                       00000450
C         COMMON VARIABLES USED                                         00000460
C                                                                       00000470
C         R2D       XP1                                                 00000480
C                                                                       00000490
C                                                                       00000500
C                                                                       00000510
C                                                                       00000520
      IMPLICIT REAL*8(A-H,O-Z)                                          00000530
      COMMON /CONST/ S2LB,D2R,XPI,R2D,F2KM,XKM2F,G0                     00000540
      DIMENSION OE(6)                                                   00000550
      DIMENSION X(3),DX(3),B(3)                                         00000560
C  THE FOLLOWING STATEMENT(S) HAVE BEEN MANUFACTURED BY THE TRANSLATOR  00000570
C  TO COMPENSATE FOR THE FACT THAT EQUIVALENCE DOES NOT REORDER COMMON--00000580
C  DIMENSION X(3),DX(3),B(3)                                            00000590
C  B IS THE SPECIFIC ANGULAR MOMENTUM VECTOR                            00000600
      CALL CROSS(X,DX,B)                                                00000610
      R2 = DOT(X,X)                                                     00000620
      R  = DSQRT(R2)                                                    00000630
      V2 = DOT(DX,DX)                                                   00000640
      B2 = DOT(B,B)                                                     00000650
C  BB IS THE MAGNITUDE OF THE SPECIFIC ANGULAR MOMENTUM                 00000660
      BB = DSQRT(B2)                                                    00000670
      A=DOT(X,DX)/U                                                     00000680
      P  = B2/U                                                         00000690
      C3 = V2-2.0D0*U/R                                                 00000700
      SMA=-U/C3                                                         00000710
      ECC=DSQRT(1.0D0+C3*P/U)                                           00000720
      OINC= ARKTNS(180,B(3),DSQRT(B(1)**2+B(2)**2))                     00000730
      OMG= ARKTNS(360,-B(2),B(1))                                       00000740
C  RCA IS THE RADIUS OF PERIGEE                                         00000750
      RCA=P/(1.0D0+ECC)                                                 00000760
      THT=ARKTNS(360,(P-R),BB*A)                                        00000770
      BET= ARKTNS(360,X(2)*B(1)-X(1)*B(2),X(3)*BB)                      00000780
      BEP= BET-THT                                                      00000790
      IF(BEP) 2,3,3                                                     00000800
    2 BEP=BEP+2.*XPI                                                    00000810
    3 CONTINUE                                                          00000820
      RTD=R2D                                                           00000830
      OINC=OINC*RTD                                                     00000840
C  OMG IS THE RIGHT ASCENSION OF THE ASCENDING NODE, IN DEGREES         00000850
      OMG=OMG*RTD                                                       00000860
C  BEP IS THE ARGUMENT OF PERIGEE, IN DEGREES                           00000870
      BEP=BEP*RTD                                                       00000880
      PERV=DSQRT(C3+2.0D0*U/RCA)                                        00000890
      VIMP=PERV-DSQRT(U/RCA)                                            00000900
      CTAS=(P/R-1.0D0)/ECC                                              00000910
      IF(DABS(CTAS).LT.1.D0.AND.DABS(CTAS-1.D0).GT.1.D-6) GO TO 200     00000920
      STAS=0.D0                                                         00000930
      GO TO 201                                                         00000940
  200 STAS=DSQRT(1.0D0-CTAS*CTAS)                                       00000950
      STAS=DSIGN(STAS,A)                                                00000960
  201 CONTINUE                                                          00000970
      THE=ARKTNS(180,CTAS,STAS)                                         00000980
C  THET IS THE TRUE ANOMALY, IN DEGREES                                 00000990
      THET=THE*RTD                                                      00001000
      CALL TCONIC(U,ECC,SMA,P,THE,TPER,FAC)                             00001010
      TPER=TPER/86400.0D0                                               00001020
      IF(SMA)10,10,11                                                   00001030
   10 CONTINUE                                                          00001040
      GO TO 12                                                          00001050
   11 F1=A*U/DSQRT(U*SMA)                                               00001060
      F2=1.0D0-R/SMA                                                    00001070
      SINE=F1/ECC                                                       00001080
      COSE=F2/ECC                                                       00001090
      E=ARKTNS(360,COSE,SINE)                                           00001100
      XMAN=(E-ECC*SINE)*RTD                                             00001110
   12 CONTINUE                                                          00001120
      OE(1) = ECC                                                       00001130
      OE(2) = SMA                                                       00001140
      OE(3) = OINC                                                      00001150
      OE(4) = OMG                                                       00001160
      OE(5) = BEP                                                       00001170
      OE(6) = THET                                                      00001180
      RETURN                                                            00001190
      END                                                               00001200
C          DATA SET ORB2X      AT LEVEL 002 AS OF 06/22/79
C          DATA SET ORB2X      AT LEVEL 001 AS OF 04/04/78              00001
C                                                                       00002
      SUBROUTINE ORB2X (X,VX,EL,U,ANOM)                                 00003
C                                                                       00004
C                                                                       00005
C     SUBROUTINE ORB2X (X,VX,EL,U,ANOM)                                 00006
C                                                                       00007
C                                                                       00008
C                                                                       00009
C     THE PURPOSE OF ORB2X IS TO CONVERT ORBITAL ELEMENTS INTO CARTESIAN00010
C         COORDINATES.                                                  00011
C                                                                       00012
C                                                                       00013
C                                                                       00014
C     ARGUMENTS IN THE CALLING SEQUENCE ARE DEFINED AS FOLLOWS.         00015
C                                                                       00016
C         ARGUMENT   TYPE    I/O        DEFINITION                      00017
C                                                                       00018
C          X(3)      R*8      O      POSITION VECTOR                    00019
C          VX(3)     R*8      O      VELOCITY VECTOR                    00020
C          EL(6)     R*8      I      ORBIT ELEMENTS                     00021
C                                       EL(1)=SEMI-MAJOR AXIS           00022
C                                       (+ IF ELLIPTIC, -IF HYPERBOLIC) 00023
C                                       EL(2)=ECCENTRICITY              00024
C                                       EL(3)=TRUE ANOMALY (DEGREES)    00025
C                                       EL(4)=NODE (DEGREES)            00026
C                                       EL(5)=INCLINATION (DEGREES)     00027
C                                       EL(6)=ARGUMENT OF PERIAPSIS     00028
C                                       (DEGREES)                       00029
C          U         R*8      I      GRAVITATIONAL CONSTANT FACTOR      00030
C          ANOM      R*8      I      ANOM=1, THEN EL(3) IS MEAN ANOMALY 00031
C                                       ANOM 1, THEN EL(3) IS TRUE      00032
C                                       ANOMALY                         00033
C                                                                       00034
C                                                                       00035
C                                                                       00036
C     ORB2X IS CALLED BY THE FOLLOWING SUBROUTINES.                     00037
C                                                                       00038
C         DELVS     MAIN                                                00039
C                                                                       00040
C                                                                       00041
C                                                                       00042
C     NO SUBROUTINES ARE CALLED BY ORB2X.                               00043
C                                                                       00044
C                                                                       00045
C                                                                       00046
C     THE FOLLOWING FUNCTION SUBPROGRAMS ARE CALLED BY ORB2X.           00047
C                                                                       00048
C         ARKTNS                                                        00049
C                                                                       00050
C                                                                       00051
C                                                                       00052
C     ORB2X NEITHER USES NOR ALTERS VARIABLES IN COMMON. ALL INPUT AND  00053
C         OUTPUT IS THROUGH THE CALLING SEQUENCE.                       00054
C                                                                       00055
C                                                                       00056
C                                                                       00057
      IMPLICIT REAL*8(A-H,O-Z,$)                                        00058
      DIMENSION  AR(3),AT(3),C(4),S(4)                                  00059
C     CONVERTS ORBITAL ELEMENTS TO CARTESIAN COORDINATES                00060
C     EL CONSISTS OF INPUT ORBITAL ELEMENTS                             00061
C       (1) SEMI-MAJOR AXIS (+ IF ELLIPTIC, - IF HYPERBOLIC)            00062
C       (2) ECCENTRICITY                                                00063
C       (3) TRUE ANOMALY (DEGREES)                                      00064
C       (4) LONGITUDE OF ASC NODE (DEGREES)                             00065
C       (5) INCLINATION (DEGREES)                                       00066
C       (6) ARGUMENT OF PERIAPSIS (DEGREES)                             00067
      DIMENSION  EL(6),VX(3),X(3)                                       00068
      DATA       D2R/0.0174532926D0  /                                  00069
      DO 1 I=1,3                                                        00070
      J = 6-I                                                           00071
      B = EL(J)*D2R                                                     00072
      S(I) = DSIN(B)                                                    00073
    1 C(I) = DCOS(B)                                                    00074
C  CONVERSION FROM MEAN ANOMALY TO TRUE ANOMALY                         00075
C  ANOM=1.- MEAN ANOMALY INPUT                                          00076
      IF(ANOM.NE.1.D0)   GO TO 3                                        00077
      XM=EL(3)* D2R                                                     00078
      ECC=EL(2)                                                         00079
C  COMPUTE THE ECCENTRIC ANOMALY, USING AN EXPANSION DUE TO             00080
C  LAGRANGE (SEE MOULTON "CELESTIAL MECHANICS" PAGE 161)                00081
      E=XM+ECC*DSIN(XM)+(ECC**2/2.D0)*DSIN(2.D0*XM)+(ECC**3/24.D0) *    00082
     .(9.D0*DSIN(3.D0*XM)-3.D0*DSIN(XM))+(ECC**4/192.D0)*(64.D0*        00083
     .DSIN(4.D0*XM)-32.D0*DSIN(2.D0*XM))                                00084
      CTA=(DCOS(E)-ECC)/(1.D0-ECC*DCOS(E))                              00085
      STA=DSQRT(1.D0-ECC**2)* DSIN(E)/(1.D0-ECC*DCOS(E))                00086
      B=ARKTNS(180,CTA,STA)                                             00087
   3  B=B + EL(6)*D2R                                                   00088
      S(4) = DSIN(B)                                                    00089
      C(4) = DCOS(B)                                                    00090
C  AR AND AT ARE UNIT VECTORS IN THE RADIAL AND TANGENTIAL              00091
C  DIRECTIONS, RESPECTIVELY.                                            00092
      AR(1) = C(2)*C(4)-(S(2)*C(1))*S(4)                                00093
      AR(2) = S(2)*C(4)+(C(2)*C(1))*S(4)                                00094
      AR(3) = S(1)*S(4)                                                 00095
      AT(1) =-C(2)*S(4)-(S(2)*C(1))*C(4)                                00096
      AT(2) =-S(2)*S(4)+(C(2)*C(1))*C(4)                                00097
      AT(3) = S(1)*C(4)                                                 00098
      P = EL(1)*(1.D0-EL(2)*EL(2))                                      00099
C     RADIUS                                                            00100
      R = P/(1.D0+EL(2)*C(3))                                           00101
C     RADIAL VELOCITY                                                   00102
      VR = EL(2)*S(3)*DSQRT(U/P)                                        00103
C     TANGENTIAL VELOCITY                                               00104
      VT = DSQRT(U*(2.D0/R-1.D0/EL(1))-VR*VR)                           00105
      DO 2 I=1,3                                                        00106
      X(I) = R*AR(I)                                                    00107
    2 VX(I)= VR*AR(I)+VT*AT(I)                                          00108
      RETURN                                                            00109
      END                                                               00110
C          DATA SET OUTPUT     AT LEVEL 014 AS OF 03/02/79
C          DATA SET OUTPUT     AT LEVEL 009 AS OF 01/31/79              00001
      SUBROUTINE OUTPUT(LU25,LEGJ,LEG,XIS,XISM,C2,C2M,RXX,VXX,DV,DVC,MN,00002
     .RAS,DEC,PERIOD,DRIFT,A8,A7)                                       00003
C                                                                       00004
C       SUBROUTINE OUTPUT(LU25,LEGJ,LEG,XIS,XISM,C2,C2M,RXX,VXX,DV,     00005
C          DVC,MN,RAS,DEC,PERIOD,A8,A7,DRIFT)                           00006
C                                                                       00007
C                                                                       00008
C       THE PURPOSE OF OUTPUT IS TO OUTPUT THE RESULTS (E.G., ORBITAL   00009
C       ELEMENTS, POSITION VECTOR, VELOCITY VECTOR COMPONENTS, ETC)     00010
C                                                                       00011
C       ARGUMENTS IN THE CALLING SEQUENCE ARE DEFINED AS FOLLOWS:       00012
C                                                                       00013
C       ARGUMENT    TYPE    I/O       DEFINITION                        00014
C        LU25       I*4      I    PRINTER OUTPUT UNIT SPECIFICATION     00015
C        LEGJ       I*4      I    LEGJ TELLS AT WHICH NODE THE          00016
C                                 MANEUVER IS PERFORMED                 00017
C        LEG        I*4      I    LEG TELLS AT WHICH NODE THE           00018
C                                 MANEUVER IS PERFORMED                 00019
C        XIS        R*8     I/O   GIVES CARTESIAN COORDINATES           00020
C                                 FOR THE ORBIT                         00021
C        XISM       R*8     I/O   CONTAINS KEPLERIAN ELEMENTS           00022
C        C2         R*8     I/O   CONTAINS ORBIT IN KEPLERIAN           00023
C                                 ELEMENTS                              00024
C        C2M        R*8     I/O   CONTAINS ORBIT IN CARTESIAN           00025
C                                 COORDINATES AFTER MANEUVER            00026
C        RXX        R*8      O    POSITION VECTOR MAGNITUDE             00027
C        VXX        R*8      O    VELOCITY VECTOR MAGNITUDE             00028
C        DV         R*8     I/O   MAGNITUDE OF THE VELOCITY CHANGE      00029
C                                 FOR THE MANEUVER                      00030
C        DVC        R*8     I/O   DELTA V VELOCITY CHANGE               00031
C                                 COMPONENTS                            00032
C        MN         I*4      I    MN INDICATES WHICH ORBIT IS TO        00033
C                                 BE CALCULATED                         00034
C        RAS        R*8     I/O   RIGHT ASCENSION OF VEHICLE            00035
C        DEC        R*8     I/O   DECLINATION OF VEHICLE                00036
C        PERIOD     R*8     I/O   ORBITAL PERIOD                        00037
C                                                                       00038
C       OUTPUT IS CALLED BY THE FOLLOWING SUBROUTINES                   00039
C                                                                       00040
C           GEOSX                                                       00041
C                                                                       00042
C       NO SUBROUTINES ARE CALLED BY OUTPUT                             00043
C                                                                       00044
C       OUTPUT NEITHER USES NOR ALTERS VARIABLES IN COMMON. ALL         00045
C       INPUT AND OUTPUT IS THROUGH THE CALLING SEQUENCE.               00046
      IMPLICIT REAL*8(A-H,O-Z)                                          00047
      DIMENSION XIS(1),C2(1),DVC(1),XISM(1),C2M(1)                      00048
      IF(MN .NE. 0)GO TO 111                                            00049
C  MN=0, WRITE OUT PARKING ORBIT OR INITIAL ORBIT                       00050
C  TITLE; THE INITIAL ORBIT PARAMETERS                                  00051
      WRITE(LU25,1001)                                                  00052
C  WRITE  THE INITIAL ORBIT IN KEPLERIAN ELEMENTS                       00053
      WRITE(LU25,1002)  C2(2),C2(1),(C2(I),I=3,6)                       00054
C  WRITE THE INITIAL ORBIT CARTESIAN COMPONENTS                         00055
      WRITE(LU25,1003)  (XIS(I),I=1,6)                                  00056
C      WRITE THE RADII OF PERIGEE AND APOGEE AND THE DRIFT RATE         00057
       WRITE(LU25,1016) A 7 ,A 8 ,DRIFT                                 00058
C  WRITE THE PERIOD OF THE INITIAL ORBIT                                00059
      WRITE(LU25,1009) PERIOD                                           00060
C  END OF PARKING OR INITIAL ORBIT OUTPUT                               00061
      RETURN                                                            00062
  111 IF(MN .NE. 1) GO TO 222                                           00063
C  THIS SEGMENT WRITES OUT THE TRANSFER ORBIT PARAMETERS                00064
C  CHECK WHICH NODE THE MANEUVER WAS PERFORMED ON                       00065
      IF(LEGJ .EQ. 1) GO TO 115                                         00066
C  LEGJ = 2 IS THE DESCENDING NODE                                      00067
C  MANEUVER PERFORMED AT THE DESCENDING NODE                            00068
      WRITE(LU25,1006)                                                  00069
      GO TO 116                                                         00070
C  MANEUVER PERFORMED AT THE ASCENDING NODE                             00071
  115 WRITE(LU25,1005)                                                  00072
C  TRANSFER ORBIT PARAMENTERS                                           00073
  116 WRITE(LU25,1007)                                                  00074
C      POSITION, VELOCITY, AN MANEUVER MAGNITUDES: MANEUVER COMPONENTS  00075
       WRITE(LU25,1004)RXX,VXX,DV,(DVC(I),I=1,3)                        00076
       WRITE(LU25,1008)RAS,DEC                                          00077
C  ARRAY C(I) FROM GEOS IS WRITTEN AT THIS POINT                        00078
C  KEPLERIAN ELEMENTS                                                   00079
      WRITE(LU25,1002) C2(2),C2(1),(C2(I),I=3,6)                        00080
C  CARTESIAN COPONENTS XII(I) FROM GEOS                                 00081
      WRITE(LU25,1003) (XIS(I),I=1,6)                                   00082
C      WRITE THE RADII OF PERIGEE AND APOGEE AND THE DRIFT RATE         00083
       WRITE(LU25,1016) A 7 ,A 8 ,DRIFT                                 00084
C  WRITE THE TRANSFER ORBIT PERIOD                                      00085
      WRITE(LU25,1009)PERIOD                                            00086
      RETURN                                                            00087
  222 IF(MN .NE. 2)GO TO 333                                            00088
C  THE DRIFT ORBIT PARAMETERS                                           00089
      IF(LEG .EQ. 1)GO TO 215                                           00090
C  LEG = 2 IS THE DESCENDING NODE                                       00091
      WRITE(LU25,1006)                                                  00092
      GO TO 216                                                         00093
 215  WRITE(LU25,1005)                                                  00094
C     DRIFT ORBIT PARAMETERS                                            00095
  216 WRITE(LU25,1010)                                                  00096
C  POSITION, VELOCITY, AND MANEUVER MAGNITUDES: MANEUVER                00097
C  COMPONENTS  C4(I)                                                    00098
      WRITE(LU25,1004)RXX,VXX,DV,(DVC(I),I=1,3)                         00099
C  WRITE THE SPACECRAFT ATTITUDE: RASYN,DECSYN                          00100
      WRITE(LU25,1008) RAS,DEC                                          00101
C  KEPLERIAN ELEMENTS BEFORE THE MANEUVER  A(I) FROM GEOS               00102
      WRITE(LU25,1011)                                                  00103
      WRITE(LU25,1002) XISM(2),XISM(1),(XISM(I),I=3,6)                  00104
C  CARTESIAN COMPONENTS BEFORE THE MANEUVER GEOS XC(I)                  00105
      WRITE(LU25,1012)                                                  00106
      WRITE(LU25,1003) (XIS(I),I=1,6)                                   00107
C  KEPLERIAN ELEMENTS AFTER THE MANEUVER (GEOS AZ(I))                   00108
      WRITE(LU25,1013)                                                  00109
      WRITE(LU25,1002) C2(2),C2(1),(C2(I),I=3,6)                        00110
C  CARTESIAN ELMENTS AFTER THE MANEUVER C3(I)                           00111
      WRITE(LU25,1014)                                                  00112
      WRITE(LU25,1003) (C2M(I),I=1,6)                                   00113
C      WRITE THE RADII OF PERIGEE AND APOGEE AND THE DRIFT RATE         00114
       WRITE(LU25,1016) A 7 ,A 8 ,DRIFT                                 00115
C  WRITE THE DRIFT ORBIT PERIOD                                         00116
      WRITE(LU25,1009)PERIOD                                            00117
      RETURN                                                            00118
 1001 FORMAT(1H0,'INITIAL ORBIT PARAMETERS        NOTE: SIGN CONVENTION 00119
     1  GIVES EASTWARD DRIFT RATE AS NEGATIVE',/)                       00120
 1002 FORMAT(1H ,'    KEPLERIAN ELEMENTS---'/,T11,'SEMI-MAJOR AXIS  . . 00121
     2. . . . . . . . . . . . . . . . . . . . . . . . . A    =',D18.10  00122
     3, '  KM.'/'          ECCENTRICITY . . . . . . . . . . . . . . . . 00123
     4. . . . . . . . . . . . . E    ='  , D18.10, /'          INCLINATI00124
     5ON. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . I   00125
     6 ='  , D18.10, '  DEGREES  '/,T11,     'RIGHT ASCENSION OF ASCENDI00126
     7NG NODE. . . . . . . . . . . . . . . . . .  NODE  =' , D18.10, '  00127
     8DEGREES '/'          ARGUMENT OF PERIGEE. . . . . . . . . . . . . 00128
     9. . . . . . . . . . . .  AOP   ='  , D18.10, '  DEGREES  '/'      00129
     A    TRUE ANOMALY OF INSERTION POINT. . . . . . . . . . . . . . . .00130
     B . . .  TRUE  =',  D18.10, '  DEGREES ')                          00131
 1003 FORMAT(1H , '        X COMPONENT OF POSITION VECTOR . . . . . . . 00132
     2. . . . . . . . . . . . . X     =', D18.10, '  KM.'/'         Y CO00133
     3MPONENT OF POSITION VECTOR . . . . . . . . . . . . . . . . . . . .00134
     4 Y     =', D18.10, '  KM.'/'         Z COMPONENT OF POSITION VECTO00135
     5R . . . . . . . . . . . . . . . . . . . . Z     =', D18.10, '  KM.00136
     6'/'         X-COMPONENT OF VELOCITY VECTOR . . . . . . . . . . . .00137
     7 . . . . . . . . XDOT  =', D18.10, '  KM./SEC.'/'         Y-COMPON00138
     8ENT OF VELOCITY VECTOR . . . . . . . . . . . . . . . . . . . . YDO00139
     9T  =', D18.10, '  KM./SEC.'/'         Z-COMPONENT OF VELOCITY VECT00140
     AOR . . . . . . . . . . . . . . . . . . . . ZDOT  =', D18.10, '  KM00141
     B./SEC.')                                                          00142
 1004 FORMAT(1H ,T12,'MAGNITUDE OF INSERTION POSITION VECTOR . . . . . .00143
     2 . . . . . . . . . RINS  =',   D18.10,'  KM.'/'           MAGNITUD00144
     3E OF INSERTION VELOCITY VECTOR . . . . . . . . . . . . . . . VINS 00145
     4 =', D18.10, '  KM./SEC.'/'           MAGNITUDE OF MANEUVER VELOCI00146
     5TY VECTOR  . . . . . . . . . . . . . . . DV    =', D18.10, '  KM./00147
     6SEC.'/'           MANEUVER VELOCITY VECTOR COMPONENTS  . . . . . .00148
     7 . . . . . . . . . . DV(1) =',D18.10, '  KM./SEC.'/, 79X,' DV(2) =00149
     8', D18.10, '  KM./SEC.'/, 79X, ' DV(3) =', D18.10, '  KM./SEC.')  00150
 1005 FORMAT(1H ,'***MANEUVER PERFORMED AT ASCENDING NODE ***')         00151
 1006 FORMAT(1H ,'***MANEUVER PERFORMED AT DESCENDING NODE***')         00152
 1008 FORMAT(1H ,T12,'INJECTION ATTITUDE',34X, 'RIGHT ASCENSION  RAS   =00153
     *',D18.10,'  DEGREES'/,T67,'DECLINATION   DEC   =',D18.10,'  DEGREE00154
     *S')                                                               00155
 1007 FORMAT(1H ,T11,'TRANSFER ORBIT INJECTION')                        00156
 1009 FORMAT(1H ,T59,'        ORBIT PERIOD  TIME  =',D18.10,'  SECONDS')00157
 1010 FORMAT(1H ,T11,'DRIFT ORBIT INJECTION')                           00158
 1011 FORMAT(1H ,T20,'ELEMENTS BEFORE THE MANEUVER')                    00159
 1012 FORMAT(1H ,T20,'CARTESIAN COMPONENTS BEFORE THE MANEUVER')        00160
 1013 FORMAT(1H ,T20,'ELEMENTS AFTER THE MANEUVER')                     00161
 1014 FORMAT(1H ,T20,'CARTESIAN COMPONENTS AFTER  THE MANEUVER')        00162
 1015 FORMAT(1H ,)                                                      00163
 1016 FORMAT(1H ,T68,'RADIUS OF PERIGEE  =',D18.10,'  KM.'/,            00164
     1 T69,'RADIUS OF APOGEE  =',D18.10,'  KM.'/,T75,                   00165
     2 'DRIFT RATE  =',D18.10,'  DEG./DAY')                             00166
  333 WRITE(LU25,1015)                                                  00167
C  SYNCHRONOUS PARAMETERS                                               00168
C  KEPLERIAN ELEMENTS GOES ARRAY( )                                     00169
      WRITE(LU25,1002) (C2(I), I =1,6)                                  00170
      RETURN                                                            00171
      END                                                               00172
      SUBROUTINE PA(AS,ES,A,RA,RP,VPN1,VP,VPN2,VAS,XMU,MAN1,MAN2)       00000010
C                                                                       00000020
C  SUBROUTINE PA(AS,ES,A,RA,RP,VPN1,VP,VPN2,VAS,XMU,MAN1,MAN2)          00000030
C                                                                       00000040
C  THE PURPOSE OF PA IS TO SIMULATE A PERIGEE MANEUVER FOLLOWED         00000050
C  BY AN APOGEE MANEUVER, IN WHICH ONLY THE SEMI-MAJOR AXIS AND         00000060
C  THE ECCENTRICITY ARE ALTERED, IN ORDER TO DETERMINE THE VELOCITY     00000070
C  REQUIREMENTS FOR THE MANEUVERS.                                      00000080
C                                                                       00000090
C  ARGUMENTS IN THE CALLING SEQUENCE ARE DEFINED AS FOLLOWS:            00000100
C                                                                       00000110
C   ARGUMENT   TYPE    I/O      DEFINITION                              00000120
C                                                                       00000130
C     AS       R*8      I     DESIRED SEMI-MAJOR AXIS                   00000140
C     ES       R*8      I     DESIRED ECCENTRICITY                      00000150
C     A        R*8      I     SEMI-MAJOR AXIS BEFORE MANEUVER BEGINS    00000160
C     RA       R*8      I     RADIUS OF APOGEE BEFORE MANEUVER BEGINS   00000170
C     RP       R*8      I     RADIUS OF PERIGEE BEFORE MANEUVER BEGINS  00000180
C     VPN1     R*8      O     PERIGEE VELOCITY AFTER PERIGEE MANEUVER   00000190
C     VP       R*8      O     PERIGEE VELOCITY BEFORE PERIGEE MANEUVER  00000200
C     VPN2     R*8      O     APOGEE VELOCITY BEFORE APOGEE MANEUVER    00000210
C     VAS      R*8      O     APOGEE VELOCITY AFTER APOGEE MANEUVER     00000220
C     XMU      R*8      I     GRAVITATIONAL CONSTANT FOR THE EARTH      00000250
C     MAN1     I*4      I     MANEUVER INDICATOR, IF MAN1=1,THE PA      00000251
C                             BURN IS FOLLOWING AN AP BURN, BUT IT      00000252
C                             IS TO BE DONE STARTING WITH THE INITIAL   00000253
C                             ORBIT, I.E., THE INPUT ORBIT IN AP        00000254
C     MAN2     I*4      I     MANEUVER INDICATOR FOR A SECOND MANEUVER. 00000255
C                             IF MAN2=1, THE SAME THING IS TO HAPPEN AS 00000256
C                             IN THE CASE MAN1=1                        00000257
C                                                                       00000260
C  PA IS CALLED BY THE FOLLOWING SUBROUTINE:                            00000270
C                                                                       00000280
C     BDELVS                                                            00000290
C                                                                       00000300
C  PA CALLS NO SUBROUTINES.                                             00000301
                                                                        00000302
C  PA NEITHER USES NOR ALTERS VARIABLES IN COMMON.  ALL INPUT           00000303
C  AND OUTPUT IS THROUGH THE CALLING SEQUENCE.                          00000304
C                                                                       00000305
C                                                                       00000306
      IMPLICIT REAL*8 (A-H,O-Z)                                         00000310
      COMMON/ELEM/AKC(12)                                               00000311
C  THIS IF STATEMENT IS PUT IN SO THAT WHEN MAN1=1, I.E., AN AP         00000312
C  MANEUVER AND A PA MANEUVER ARE CALLED FOR, THE A,E CHANGES           00000313
C  RESULTING FROM THE AP MANEUVER WILL NOT BE CARRIED ALONG             00000314
C  WHEN THEN PA BURN IS DONE.                                           00000315
      IF (MAN1.EQ.1.OR.MAN2.EQ.1) GO TO 44                              00000316
C  PERIGEE MANEUVER CALCULATIONS BEGIN.                                 00000330
      IF(AKC(1).EQ.0.D0) GO TO 40                                       00000340
      A=AKC(1)                                                          00000341
C  RAS IS THE DESIRED RADIUS OF PERIGEE AFTER THE MANEUVER IS           00000361
C  COMPLETED.                                                           00000362
   40 RP=2.D0*A-RA                                                      00000363
   44 RAS=AS*(1.D0+DABS(ES))                                            00000370
C  ANP IS THE INTERMEDIATE SEMI-MAJOR AXIS AFTER THE PERIGEE            00000371
C  MANEUVER.                                                            00000372
      ANP=(RP+RAS)/2.D0                                                 00000380
      VPN1=DSQRT(XMU*(2.D0/RP-1.D0/ANP))                                00000390
      VP=DSQRT(XMU*(2.D0/RP-1.D0/A))                                    00000400
C APOGEE MANEUVER CALCULATIONS BEGIN.                                   00000410
      VPN2=DSQRT(XMU*(2.D0/RAS-1.D0/ANP))                               00000420
      VAS=DSQRT(XMU*(2.D0/RAS-1.D0/AS))                                 00000430
      AKC(1)=AS                                                         00000431
      AKC(2)=ES                                                         00000432
      RETURN                                                            00000460
      END                                                               00000470
C          DATA SET PARTAL     AT LEVEL 003 AS OF 06/25/79
C          DATA SET PARTAL     AT LEVEL 002 AS OF 06/01/79              00001
C                                                                       00002
      SUBROUTINE PARTAL (PAR,TR, TV, T50,ALPH,BET,THRUS)                00003
C                                                                       00004
C                                                                       00005
C     SUBROUTINE PARTAL (PAR,TR,TV,T50,ALPH,BET,THRUS)                  00006
C                                                                       00007
C                                                                       00008
C                                                                       00009
C     THE PURPOSE OF PARTAL IS TO CALCULATE A MATRIX OF THE THRUST      00010
C         PARTIAL DERIVATIVES AND A MATRIX OF POSITION AND VELOCITY     00011
C         UNIT VECTORS.                                                 00012
C                                                                       00013
C                                                                       00014
C                                                                       00015
C     ARGUMENTS IN THE CALLING SEQUENCE ARE DEFINED AS FOLLOWS.         00016
C                                                                       00017
C         ARGUMENT   TYPE    I/O        DEFINITION                      00018
C                                                                       00019
C          PAR(3,3)  R*16     O      THRUST PARTIAL DERIVATIVE          00020
C          TR(3)     R*8      I      POSITION VECTOR                    00021
C          TV(3)     R*8      I      VELOCITY VECTOR                    00022
C          T50(3,3)  R*16     O      POSITION AND VELOCITY UNIT         00023
C                                        VECTOR MATRIX                  00024
C          APLH      R*8      I      INITIAL DECLINATION                00025
C          BET       R*8      I      INITIAL RIGHT ASCENSION            00026
C          THRUS     R*8      I      THRUST VALUE                       00027
C                                                                       00028
C                                                                       00029
C                                                                       00030
C     PARTAL IS CALLED BY THE FOLLOWING SUBROUTINES.                    00031
C                                                                       00032
C         CVPROP                                                        00033
C                                                                       00034
C                                                                       00035
C                                                                       00036
C     THE FOLLOWING SUBROUTINE IS CALLED BY PARTAL.                     00037
C                                                                       00038
C         CROSS                                                         00039
C                                                                       00040
C                                                                       00041
C                                                                       00042
C     THE FOLLOWING FUNCTION SUPPROGRAM IS CALLED BY PARTAL.            00043
C                                                                       00044
C         FNORM                                                         00045
C                                                                       00046
C                                                                       00047
C                                                                       00048
C     PARTAL NEITHER USES NOR ALTERS VARIABLES IN COMMON. ALL           00049
C         INPUT AND OUTPUT IS THROUGH THE CALLING SEQUENCE.             00050
C                                                                       00051
C                                                                       00052
C                                                                       00053
C                                                                       00054
      IMPLICIT REAL*8(A-H,O-Z)                                          00055
      DOUBLE PRECISION PAR(3,3), T50(6,3)                               00056
      COMMON /CONST/ S2LB,D2R,XPI,R2D,F2KM,XKM2F,G0                     00057
      DIMENSION TR(3), TV(3), Y(3), Z(3)                                00058
      T=THRUS*S2LB                                                      00059
      ALPHA=ALPH/R2D                                                    00060
      BETA=BET/R2D                                                      00061
      SALPHA = DSIN (ALPHA)                                             00062
      CALPHA = DCOS(ALPHA)                                              00063
      SBETA = DSIN(BETA)                                                00064
      CBETA = DCOS(BETA)                                                00065
C  COMPUTE THE THRUST PARTIAL DERIVATIVES                               00066
      PAR(1,1) = CALPHA* CBETA                                          00067
      PAR(2,1) = -SALPHA*CBETA                                          00068
      PAR(3,1) = SBETA                                                  00069
      PAR(1,2) = -T*SALPHA*CBETA                                        00070
      PAR(2,2) = -T*PAR(1,1)                                            00071
      PAR(3,2) = 0.D0                                                   00072
      PAR(1,3) = -T*CALPHA*SBETA                                        00073
      PAR(2,3) = T*SALPHA*SBETA                                         00074
      PAR(3,3) = T*CBETA                                                00075
C  COMPUTE THE VELOCITY MAGNITUDE                                       00076
      VM = FNORM(TV)                                                    00077
      CALL CROSS (TR,TV,Z)                                              00078
      CALL CROSS (Z, TV, Y)                                             00079
      YM = FNORM(Y)                                                     00080
C  COMPUTE THE MAGNITUDE OF THE SPECIFIC ANGULAR MOMENTUM               00081
      ZM = FNORM(Z)                                                     00082
C  COMPUTE THE POSITION AND VELOCITY UNIT VECTOR MATRIX                 00083
      DO 1 I=1,3                                                        00084
      T50(I,1) = TV(I)/VM                                               00085
      T50(I,2)=Y(I) /YM                                                 00086
      T50(I,3) = Z(I) /ZM                                               00087
1     CONTINUE                                                          00088
      RETURN                                                            00089
      END                                                               00090
C          DATA SET POWERX     AT LEVEL 003 AS OF 06/25/79
C          DATA SET POWERX     AT LEVEL 002 AS OF 05/18/79              00001
C          DATA SET POWERX     AT LEVEL 001 AS OF 04/04/78              00002
C                                                                       00003
      SUBROUTINE POWERX(XT, VT,XLT,XMT,XMDOTT,TT,GMBOD ,TSP,P,PM)       00004
C                                                                       00005
C                                                                       00006
C  SUBROUTINE POWERX(XT, VT,XLT,XMT,XMDOTT,TT,GMBOD ,TSP,P,PM)          00007
C                                                                       00008
C  THIS SUBROUTINE COMPUTES THE STATE TRANSITION MATRIX P               00009
C  AT TIME T DURING POWERED FLIGHT, AND THE FORWARD PROPAGATION         00010
C  MATRIX PM.                                                           00011
C                                                                       00012
C  ARGUMENTS IN THE CALLING SEQUENCE ARE DEFINED AS FOLLOWS:            00013
C                                                                       00014
C  ARGUMENT  TYPE  I/O     DEFINITION                                   00015
C                                                                       00016
C     XT     R*8    I     POSITION VECTOR AT TIME, T                    00017
C     VT     R*8    I     VELOCITY VECTOR AT TIME, T                    00018
C     XLT    R*8    I     INERTIAL THRUST VECTOR                        00019
C     XMT    R*8    I     INITIAL SPACECRAFT MASS                       00020
C     XMDOTT R*8    I     TIME RATE OF MASS USE, DM/DT                  00021
C     TT     R*8    I     INITIAL VALUE FOR THE TIME, T                 00022
C     GMBOD  R*8    I     GRAVITATIONAL CONSTANT FOR THE EARTH          00023
C     TSP    R*8    I     BURN TIME                                     00024
C     P      R*8    O     STATE TRANSITION MATRIX                       00025
C     PM     R*8    O     FORWARD PROPAGATION MATRIX                    00026
C                                                                       00027
C  POWERX IS CALLED BY THE FOLLOWING SUBROUTINE:                        00028
C                                                                       00029
C     CVPROP                                                            00030
C                                                                       00031
C  NO SUBROUTINES ARE CALLED BY POWERX                                  00032
C                                                                       00033
C  POWERX NEITHER USES NOR ALTERS VARIABLES IN COMMON.  ALL INPUT       00034
C  AND OUTPUT IS THROUGH THE CALLING SEQUENCE.                          00035
C                                                                       00036
C                                                                       00037
      IMPLICIT REAL*8(A-H,K-Z)                                          00038
      DIMENSION XT(3),VT(3),XLT(3),XTR(3),VTR(3),LTR(3),P(6,6),PM(6,3)  00039
      DO 30 I=1,3                                                       00040
      XTR(I) = XT(I)                                                    00041
      VTR(I) = VT(I)                                                    00042
30    LTR(I) = XLT(I)                                                   00043
      MTR=XMT                                                           00044
      MDOTTR = XMDOTT                                                   00045
      TR = TT                                                           00046
      GMBODY = GMBOD                                                    00047
      T = TSP                                                           00048
      RSQ = ( XTR(1)**2  + XTR(2)**2  + XTR(3)**2 )                     00049
      RCUBE = RSQ * DSQRT(RSQ)                                          00050
      DT = T - TR                                                       00051
C  COMPUTE THE COEFFICIENT REQUIRED FOR THE CALCULATION OF THE P AND PM 00052
C  MATRICES                                                             00053
      A  =  GMBODY / RCUBE                                              00054
      B =  A * DT                                                       00055
      C =  B * DT/2.0D00                                                00056
      D =  3.0D00 * C / RSQ                                             00057
      E =  DT / RCUBE                                                   00058
      F =  E * DT/ 2.0D00                                               00059
      G =  3.0D00 * B / RSQ                                             00060
      H =  MTR + MDOTTR  * DT                                           00061
      K =  DLOG(H/ MTR)/ MDOTTR                                         00062
C  THE TWO DO LOOPS COMPUTE THE STATE TRANSITION MATRIX                 00063
      DO 1  I = 1,3                                                     00064
      DO 2  J = 1,3                                                     00065
      P(I,J) =  D * XTR(I) * XTR(J)                                     00066
      P(I,J+3) =  0.0D00                                                00067
      P(I+3,J) =  G * XTR(I) * XTR(J)                                   00068
      P(I+3,J+3) = 0.0D00                                               00069
      IF ( I .NE. J ) GO TO 2                                           00070
      P(I,J) = P(I,J) + 1.0D00 - C                                      00071
      P(I,J+3) = DT                                                     00072
      P(I+3,J ) = P(I+3,J) - B                                          00073
      P(I+3,J+3) = 1.0D00                                               00074
  2   CONTINUE                                                          00075
  1   CONTINUE                                                          00076
C  COMPUTE THE MAGNITUDE OF THE INERTIAL THRUST                         00077
      MAG = DSQRT(LTR(1)**2+LTR(2)**2+LTR(3)**2)                        00078
      K1 = MDOTTR*K                                                     00079
      XTERM = -(DT-(MTR/MDOTTR+DT)*K1)/MDOTTR                           00080
      XTERM1= (2.0D00*DT-(2.0D00*MTR/MDOTTR+DT)*K1)/(MDOTTR*MAG**2)     00081
C  THE TWO DO LOOPS COMPUTE THE FORWARD PROPAGATION MATRIX              00082
      DO 10 I=1,3                                                       00083
      DO 10 J=1,3                                                       00084
      PM(I,J)=XTERM1*LTR(I)*LTR(J)                                      00085
      IF(I.EQ.J) PM(I,J) = PM(I,J)+XTERM                                00086
   10 CONTINUE                                                          00087
      XTERM1 = -(K1/MAG-MDOTTR*DT/(MAG*H))/(MDOTTR*MAG)                 00088
      DO 20 I=4,6                                                       00089
      DO 20 J=1,3                                                       00090
      PM(I,J) = XTERM1*LTR(I-3)*LTR(J)                                  00091
      IF(I-3.EQ.J) PM(I,J) = PM(I,J)+K                                  00092
   20 CONTINUE                                                          00093
      RETURN                                                            00094
      END                                                               00095
C          DATA SET PREP       AT LEVEL 016 AS OF 05/29/79
C          DATA SET PREP       AT LEVEL 004 AS OF 04/13/78              00001
      SUBROUTINE PREP(RO,VO,LAMDOT,XISP,THRUST,W1,SNODE,INCSY,DELNOD,   00002
     1PITCHI,YAWI,TCOAST,TBURN,DW,R,V,MU,DV,PITCH,YAW,LEG,K,DVIN,IGUID, 00003
     2AS,TERR,ITOPT,ALPHA,BETA,NCONF,ALI,ALF,ALD,FPA,TAMAN,             00004
     * C4,SIGBI,IKEY,IFRN)                                              00005
C                                                                       00006
C                                                                       00007
C     SUBROUTINE PREP (RO,VO,LAMDOT,XISP,THRUST,W1,SNODE,INCSY,DELNOD,  00008
C         PITCH1,YAW1,TCOAST,TBURN,DW,R,V,MU,DV,PITCH,YAW,LEG,K,DVIN,   00009
C         IGUID,AS,TERR,ITOPT,ALPHA,BETA,NCONF,AL1,ALF,ALD,ISCFLAG,FPA, 00010
C         TAMAN)                                                        00011
C                                                                       00012
C                                                                       00013
C                                                                       00014
C     THE PURPOSE OF PREP IS TO PERFORM AN APOGEE BOOST MOTOR (ABM) BURN00015
C        USING ONE OF THREE GUIDANCE TECHNIQUES.                        00016
C                                                                       00017
C                                                                       00018
C                                                                       00019
C     ARGUMENTS IN THE CALLING SEQUENCE ARE DEFINED AS FOLLOWS.         00020
C                                                                       00021
C         ARGUMENT   TYPE    I/O        DEFINITION                      00022
C                                                                       00023
C          RO(3)     R*8      I      INITIAL POSITION VECTOR OF TRANSFER00024
C                                       ORBIT                           00025
C          VO(3)     R*8      I      INITIAL VELOCITY VECTOR OF TRANSFER00026
C                                       ORBIT                           00027
C          LAMDOT    R*8      I      DRIFT RATE OF TARGET ORBIT         00028
C          XISP      R*8      I      ABM SPECIFIC IMPULSE               00029
C          THRUST    R*8      I      ABM AVERAGE THRUST                 00030
C          W1        R*8      I      INITIAL VEHICLE WEIGHT             00031
C          SNODE     R*8      O      RIGHT ASCENSION OF SYNCHRONOUS     00032
C                                       ORBIT ASCENDING NODE            00033
C          INCSY     R*8      I      INCLINATION OF SYNCHRONOUS ORBIT   00034
C          DELNOD    R*8      I      INCREMENT OF NODE ROTATION REQUIRED00035
C                                       FOR TARGET ORBIT                00036
C          PITCH1    R*8      I      PITCH OF VEHICLE BEFORE ABM BURN   00037
C          YAW1      R*8      I      YAW OF VEHICLE BEFORE ABM BURN     00038
C          TCOAST    R*8      O      COAST TIME OF TRANSFER ORBIT       00039
C          TBURN     R*8      O      ABM BURN TIME                      00040
C          DW        R*8      O      FUEL MASS USED FOR ABM BURN        00041
C          R(3)      R*8      O      POSITION VECTOR AT ABM IGNITION    00042
C          V(3)      R*8      O      VELOCITY VECTOR AT ABM IGNITION    00043
C          MU        R*8      I      GRAVITATIONAL CONSTANT             00044
C          DV        R*8      O      REQUIRED DELTA VELOCITY OF THE ABM 00045
C          PITCH     R*8      O      PITCH OF VEHICLE AFTER ABM BURN    00046
C          YAW       R*8      O      YAW OF VEHICLE AFTER ABM BURN      00047
C          LEG       I*4      I      ABM MANEUVER POINT FLAG,           00048
C                                       =1, BURN ON ASCENDING LEG       00049
C                                       RELATIVE NODE,                  00050
C                                       =2, BURN ON DESCENDING LEG      00051
C                                       RELATIVE NODE                   00052
C          K         I*4     I/O     COUNTER INDICATING CURRENT SAMPLE  00053
C                                       NUMBER                          00054
C          DYIN      R*8      I      FIXED DELTA VELOCITY OF ABM        00055
C          IGUID     I*4      I      ABM GUIDANCE FLAG,                 00056
C                                       =1, EMPLOY FUSIT TECHNIQUE      00057
C                                       =2, EMPLOY TBERR TECHNIQUE      00058
C                                       =3, EMPLOY NOVAK TECHNIQUE      00059
C          AS        R*8      I      TARGET SEMI-MAJOR AXIS REFLECTING  00060
C                                       DESIRED DRIFT RATE              00061
C          TERR      R*8      O      TIMING ERROR FOR ABM BURN (SEE     00062
C                                       ITOPT FLAG)                     00063
C          ITOPT     I*4      I      TIMING ERROR FLAG,                 00064
C                                       =0, CONSTANT ERROR,             00065
C                                       =1, RANDOM ERROR                00066
C          ALPHA     R*8      I      RIGHT ASCENSION OF VEHICLE AT ABM  00067
C          BETA      R*8      I      DECLINATION OF VEHICLE AT ABM      00068
C          NCONF     I*4      I      CURRENT SAMPLE NUMBER              00069
C          AL1       R*8      I      INITIAL ALPHA FOR SCAN IN MINDVH   00070
C          ALF       R*8      I      FINAL ALPHA FOR SCAN IN MINDVH     00071
C          ALD       R*8      I      ALPHA STEP SIZE                    00072
C          ISCFLAG   I*4      I      PRINT OPTION FOR SUBROUTINE MINDVH 00073
C          FPA       R*8     I/O     FLIGHT PATH ANGLE FOR MINDVH       00074
C          TAMAN     R*8      I      OPTIONAL INPUT TRUE ANOMALY        00075
C                                                                       00076
C                                                                       00077
C          C4(3)      R*8     O      COMPONENTS OF MANEUVER DELTA       00078
C                                    VELOCITY WITH ERRORS APPLIED       00079
C                                                                       00080
C          SIGBI(2)   R*8     I      MANEUVER ERRORS                    00081
C                                    SIGBI(1) = ONE SIGMA FRACTIONAL    00082
C                                       ERROR IN DELTA V MAGNITUDE      00083
C                                    SIGBI(2) = ONE SIGMA POINTING      00084
C                                       ERROR                           00085
C                                                                       00086
C     PREP IS CALLED BY THE FOLLOWING SUBROUTINES.                      00087
C                                                                       00088
C         GEOS   GEOSY                                                  00089
C                                                                       00090
C                                                                       00091
C                                                                       00092
C                                                                       00093
C     THE FOLLOWING SUBROUTINES ARE CALLED BY PREP.                     00094
C                                                                       00095
C         CROSS     MINDVH    SARA      STEPD     BARN1       UCROSS    00096
C                                                                       00097
C                                                                       00098
C                                                                       00099
C     THE FOLLOWING FUNCTION SUBPROGRAMS ARE CALLED BY PREP.            00100
C                                                                       00101
C         DOT       FNORM                                               00102
C                                                                       00103
C                                                                       00104
C                                                                       00105
C     THE VARIABLES APPEARING IN COMMON BLOCKS ARE TABULATED BELOW.     00106
C                                                                       00107
C         COMMON VARIABLES USED                                         00108
C                                                                       00109
C         D2R       F2KM      G0        R2D       XP1                   00110
C                                                                       00111
C                                                                       00112
C                                                                       00113
C                                                                       00114
C     VARIABLE DEFINITIONS                                              00115
C                                                                       00116
C     RO(3)  - INITIAL POSITION VECTOR OF THE TRANSFER ORBIT - I        00117
C     VO(3)  - INITIAL VELOCITY VECTOR OF THE TRANSFER ORBIT - I        00118
C     LAMDOT - DRIFT RATE OF THE TARGET ORBIT - I                       00119
C     XISP   - SPECIFIC IMPULSE OF THE APOGEE BOOST MOTOR(ABM) - I      00120
C     THRUST - THRUST OF THE ABM - I                                    00121
C     W1     - INITIAL WEIGHT OF THE VEHICLE - I                        00122
C     SNODE  - RIGHT ASCENSION OF THE SYNCHRONOUS ORBIT ASCENDING NODE-O00123
C     INCSY  - INCLINATION OF THE SYNCHRONOUS ORBIT - I                 00124
C     DELNOD - INCREMENT OF NODE ROTATION REQUIRED FOR TARGET ORBIT - I 00125
C     PITCHI - PITCH OF THE VEHICLE BEFORE ABM BURN - I                 00126
C     YAWI   - YAW OF THE VEHICLE BEFORE ABM BURN - I                   00127
C     TCOAST - COAST TIME OF THE TRANSFER ORBIT - O                     00128
C     TBURN  - BURN TIME OF THE ABM - O                                 00129
C     DW     - DECREASE IN VEHICLE WEIGHT FOLLOWING ABM BURN - O        00130
C     R(3)   - POSITION VECTOR OF THE TRANSFER ORBIT AT ABM BURN - O    00131
C     V(3)   - VELOCITY VECTOR OF THE TRANSFER ORBIT AT ABM BURN - O    00132
C     MU     - GRAVITATIONAL CONSTANT - I                               00133
C     DV     - REQUIRED DELTA-VELOCITY OF THE ABM - O                   00134
C     PITCH  - PITCH OF THE VEHICLE AFTER ABM BURN - O                  00135
C     YAW    - YAW OF THE VEHICLE AFTER ABM BURN - O                    00136
C     LEG    - FLAG INDICATING ABM MANEUVER POINT - I                   00137
C                1= BURN ON ASCENDING LEG RELATIVE NODE                 00138
C                2= BURN ON DESCENDING LEG RELATIVE NODE                00139
C     K      - COUNTER INDICATING THE CURRENT SAMPLE NUMBER - I/O       00140
C     DVIN   - FIXED DELTA-VELOCITY OF THE ABM - I                      00141
C     IGUID  - ABM GUIDANCE FLAG - I                                    00142
C                1= EMPLOY FUSIT TECHNIQUE                              00143
C                2= EMPLOY TBERR TECHNIQUE                              00144
C                3= EMPLOY NOVAK TECHNIQUE                              00145
C     AS     - TARGET SEMI-MAJOR AXIS REFLECTING DESIRED DRIFT RATE - I 00146
C     TERR   - TIMING ERROR FOR ABM BURN (CONSTANT FOR ITOPT=0,RANDOM   00147
C              FOR ITOPT=1)                                             00148
C     NCONF  - TOTAL NUMBER OF DATA POINTS CURRENTLY BEING PROCESSED -I 00149
C     ALI    - START VALUE FOR SCAN IN MINDVH - I                       00150
C     ALF    - ENDING VALUE FOR SCAN IN MINDVH - I                      00151
C     ALD    - INCREMENTAL VALUE FOR SCAN IN MINDVH - I                 00152
C     ISCFLG - PRINT OPTION FLAG FOR SUB. MINDVH - I                    00153
C     FPA    - FLIGHT PATH ANGLE FOR SUB  MINDVH - I/O                  00154
C     TAMAN  - MANUAL TRUE ANOMALY VALUE - I                            00155
      IMPLICIT REAL*8(A-H,O-Z,$)                                        00156
      REAL*8 INCS                                                       00157
      REAL*8  RO(3),VO(3),HT(3),NODET,INCT,HS(3),INCSY,RNODE(3),TEST(3),00158
     1CB(20),MU,UVS(3),VS(3),R(3),V(3),DVABM(3),UVABM(3),T(6,3),LAMDOT  00159
      COMMON /CONST/ S2LB,D2R,XPI,R2D,F2KM,XKM2F,G0                     00160
      DIMENSION UDV(3)                                                  00161
      EQUIVALENCE (UVABM(1),UDV(1))                                     00162
      DIMENSION V1(3),C4(3),SIGBI(2),XU(3),YU(3),ZU(3)                  00163
      DN=DELNOD/R2D                                                     00164
      INCS=INCSY/R2D                                                    00165
C                                                                       00166
C                                                                       00167
C                                                                       00168
C COMPUTE UNIT ANGULAR MOMENTUM VECTOR OF THE TRANSFER ORBIT            00169
      CALL UCROSS(RO,VO,HT)                                             00170
C COMPUTE RIGHT ASCENSION OF THE TRANSFER-ORBIT ASCENDING NODE          00171
      NODET =DATAN2(HT(1),-HT(2))                                       00172
C                                                                       00173
      IF(K.EQ.0) SNODE = NODET+DN                                       00174
C                                                                       00175
C COMPUTE UNIT ANGULAR MOMENTUM VECTOR OF THE TARGET ORBIT              00176
      HS(1) = DSIN(SNODE)*DSIN(INCS)                                    00177
      HS(2) =-DCOS(SNODE)*DSIN(INCS)                                    00178
      HS(3) = DCOS(INCS)                                                00179
C COMPUTE LINE OF RELATIVE NODES                                        00180
      CALL UCROSS(HT,HS,RNODE)                                          00181
C TEST FOR CORRECT MANEUVER POINT                                       00182
      CALL  CROSS(HT,RNODE,TEST)                                        00183
      IF(TEST(3).LE.0.D0.AND.LEG.EQ.1)GO TO 10                          00184
      IF(TEST(3).GT.0.D0.AND.LEG.EQ.2)GO TO 10                          00185
      GO TO 20                                                          00186
   10 RNODE(1)=-RNODE(1)                                                00187
      RNODE(2)=-RNODE(2)                                                00188
      RNODE(3)=-RNODE(3)                                                00189
   20 CONTINUE                                                          00190
      CALL CROSS(RO,RNODE,TEST)                                         00191
C COMPUTE TRUE ANOMALY                                                  00192
      TA = DATAN2(DOT(TEST,HT),DOT(RO,RNODE))                           00193
      IF (TA.LT.0.D0) TA= 2.D0*XPI+TA                                   00194
      IF(TAMAN.GT.0.D0)TA=TAMAN*D2R                                     00195
      N=1                                                               00196
C COMPUTE POSITION,VELOCITY,AND COAST-TIME AT THE MANEUVER POINT        00197
      CALL STEPD(N,TCOAST,TA,RO,VO,MU,R,V,0,CB)                         00198
      RE=FNORM(R)                                                       00199
C COMPUTE MAGNITUDE OF THE TARGET-ORBIT VELOCITY                        00200
      VSMAG=DSQRT(MU*(2.D0/RE-1.D0/AS))                                 00201
C COMPUTE THE UNIT VELOCITY VECTOR OF THE TARGET ORBIT                  00202
C     FIXED TRUE ANOMALY PLANE CHANGE                                   00203
      IF(TAMAN.LE.0.D0)GOTO 22                                          00204
      CALL UCROSS(HT,R,TEST)                                            00205
      DO21I=1,3                                                         00206
      HS(I)=HT(I)*DCOS(DN)-TEST(I)*DSIN(DN)                             00207
      RNODE(I)=R(I)/RE                                                  00208
  21  CONTINUE                                                          00209
  22  INCS=DARCOS(HS(3))                                                00210
      SNODE=DATAN2(HS(1),-HS(2))                                        00211
      CALL CROSS(HS,RNODE,UVS)                                          00212
C DETERMINE THE PROPER GUIDANCE TECHNIQUE                               00213
      IF(DVIN.EQ.0.D0) GO TO 25                                         00214
      IF(IGUID.EQ.1.OR.IGUID.EQ.3) GO TO 25                             00215
C RECOMPUTE VELOCITY MAGNITUDE OF THE TARGET ORBIT USING A FIXED        00216
C   DELTA-VELOCITY                                                      00217
      VMAG = FNORM(V)                                                   00218
      E = DARCOS(DOT(V,UVS)/VMAG)                                       00219
      DV=DVIN*F2KM                                                      00220
      A = DARSIN((VMAG*DSIN(E))/DV)                                     00221
      Z=XPI-A-E                                                         00222
      VSMAG=VMAG*VMAG + DV*DV - 2.D0*VMAG*DV*DCOS(Z)                    00223
      VSMAG=DSQRT(VSMAG)                                                00224
   25 DO 30 I=1,3                                                       00225
      VS(I) = VSMAG*UVS(I)                                              00226
C COMPUTE THE REQUIRED DELTA-VELOCITY                                   00227
      DVABM(I) = VS(I)-V(I)                                             00228
   30 CONTINUE                                                          00229
      IF(DVIN.EQ.0.D0) DV=FNORM(DVABM)                                  00230
      IF(DVIN.NE.0.D0) DV=DVIN*F2KM                                     00231
C COMPUTE DELTA-VELOCITY UNIT VECTOR                                    00232
      IF(IGUID.EQ.3)CALL MINDVH(HS,R,V,DV,ALI,ALF,ALD,MU,               00233
     .DVABM,FPA,INCS,SNODE)                                             00234
      DV=FNORM(DVABM)                                                   00235
      UVABM(1)=DVABM(1)/DV                                              00236
      UVABM(2)=DVABM(2)/DV                                              00237
      UVABM(3)=DVABM(3)/DV                                              00238
      IF(K.EQ.0)CALL SARA(UVABM,ALPHA,BETA,NCONF)                       00239
      IF(PITCHI.EQ.0.D0.AND.YAWI.EQ.0.D0) GO TO 81                      00240
      TRA=YAWI*D2R                                                      00241
      TDC=PITCHI*D2R                                                    00242
      ALPHA=TRA                                                         00243
      BETA=TDC                                                          00244
      UVABM(1)=DCOS(TRA)*DCOS(TDC)                                      00245
      UVABM(2)=DSIN(TRA)*DCOS(TDC)                                      00246
      UVABM(3)=DSIN(TDC)                                                00247
   81 CONTINUE                                                          00248
      DVFT=DV/F2KM                                                      00249
      IF(DVIN.NE. 0.D0)DVFT =DVIN                                       00250
C COMPUTE ABM BURN TIME                                                 00251
C                                                                       00252
      TEMP =DVFT/(G0*XISP)                                              00253
      W2 = W1/DEXP(TEMP)                                                00254
      DW = W2-W1                                                        00255
      WDOT = THRUST/XISP                                                00256
      TBURN = DABS(DW/WDOT)                                             00257
      DV=DVFT*F2KM                                                      00258
  202 CONTINUE                                                          00259
      TERS = TERR                                                       00260
      IF(ITOPT.EQ.0)GO TO 2001                                          00261
      IF(K.EQ.0.AND.ITOPT.EQ.1) GO TO 2002                              00262
      IF(ITOPT.EQ.1) TERS=BARN1(-1,IKEY,IFRN,TERR)                      00263
      GO TO 2001                                                        00264
 2002 CONTINUE                                                          00265
      TERS=0.D0                                                         00266
 2001 CONTINUE                                                          00267
      DTC=0.D0                                                          00268
      IF(TERS.EQ.0.D0) GO TO 201                                        00269
      TCOAST=TCOAST + TERS                                              00270
      CALL STEPD(N,TCOAST,TA,RO,VO,MU,R,V,1,CB)                         00271
      TAD=TA*D2R                                                        00272
      IF(K.EQ.0) WRITE(6,34) TAD,TA                                     00273
   34 FORMAT(' ','TAD= ',F10.4,5X,'TA= ',F10.4)                         00274
  201 CONTINUE                                                          00275
      DVK = DV                                                          00276
      C4(1)=DV*UDV(1)                                                   00277
      C4(2)=DV*UDV(2)                                                   00278
      C4(3)=DV*UDV(3)                                                   00279
      IF (K.EQ.0) GO TO 879                                             00280
      DVK = BARN1(-1,IKEY,IFRN,SIGBI(1)*DV)+DV                          00281
      ZU(1)=UDV(1)                                                      00282
      ZU(2)=UDV(2)                                                      00283
      ZU(3)=UDV(3)                                                      00284
      ZM=FNORM(ZU)                                                      00285
      RM=FNORM(R)                                                       00286
      TESX=DOT(R,ZU)/(ZM*RM)                                            00287
      IF(DABS(TESX-1.0D0) .GT. 1.0D-6) CALL UCROSS(R,ZU,XU)             00288
      IF(DABS(TESX-1.0D0) .LE. 1.0D-6) CALL UCROSS(V,ZU,XU)             00289
      CALL UCROSS(UDV,XU,YU)                                            00290
      THETA=D2R*BARN1(-1,IKEY,IFRN,SIGBI(2))                            00291
      DELTA=2.0*XPI*BARN1(1,IKEY,IFRN,0.0D0)                            00292
      THETA=DABS(THETA)                                                 00293
      CT=DCOS(THETA)                                                    00294
      ST=DSIN(THETA)                                                    00295
      CD=DCOS(DELTA)                                                    00296
      SD=DSIN(DELTA)                                                    00297
      STCD=ST*CD                                                        00298
      STSD=ST*SD                                                        00299
      C4(1)=    (CT*ZU(1)+STCD*XU(1)+STSD*YU(1))                        00300
      C4(2)=    (CT*ZU(2)+STCD*XU(2)+STSD*YU(2))                        00301
      C4(3)=    (CT*ZU(3)+STCD*XU(3)+STSD*YU(3))                        00302
      DEL=DELTA*R2D                                                     00303
      THD=THETA*R2D                                                     00304
      C4M=FNORM(C4)                                                     00305
      C4(1)=C4(1)*DVK/C4M                                               00306
      C4(2)=C4(2)*DVK/C4M                                               00307
      C4(3)=C4(3)*DVK/C4M                                               00308
  879 CONTINUE                                                          00309
      PITCH=DARSIN(C4(3)/DVK)*R2D                                       00310
      YAW=DATAN2(C4(2),C4(1))*R2D                                       00311
      RETURN                                                            00312
      END                                                               00313
C          DATA SET RANDOM     AT LEVEL 003 AS OF 06/22/79
C          DATA SET RANDOM     AT LEVEL 002 AS OF 06/01/79              00001
      SUBROUTINE RANDOM (EV,E,XB,XC,IKEY,IFRN)                          00002
C                                                                       00003
C                                                                       00004
C     SUBROUTINE RANDOM (EV,E,XB,XC,IKEY,IFRN)                          00005
C                                                                       00006
C                                                                       00007
C                                                                       00008
C     THE PURPOSE OF RANDOM IS TO GENERATE A RANDOM ERROR WHICH IS ADDED00009
C         TO THE STATE VECTOR.                                          00010
C                                                                       00011
C                                                                       00012
C                                                                       00013
C     ARGUMENTS IN THE CALLING SEQUENCE ARE DEFINED AS FOLLOWS.         00014
C                                                                       00015
C         ARGUMENT   TYPE    I/O        DEFINITION                      00016
C                                                                       00017
C          EV(6,6)   R*8      I      TRANSFORMATION FROM EIGENVECTOR    00018
C                                       SYSTEM TO STATE VECTOR          00019
C                                       COORDINATE SYSTEM               00020
C          E(6)      R*8      I      VARIANCE IN THE EIGENVECTOR SYSTEM 00021
C          XB(6)     R*8      I      STATE VECTOR WITH NO ERRORS        00022
C          XC(6)     R*8      O      STATE VECTOR WITH ERRORS           00023
C          IKEY      I*4      I      IKEY=-1, DEFAULT STARTING VALUE    00024
C                                       USED IN RANDOM NUMBER GENERATOR 00025
C                                       IKEY=0, INPUT STARTING VALUE,   00026
C                                       IFRN, IN RANDOM NUMBER GENERATOR00027
C          IFRN      I*4     I/O     PARAMETER USED IN RANDOM NUMBER    00028
C                                       GENERATOR                       00029
C                                                                       00030
C                                                                       00031
C                                                                       00032
C     RANDOM IS CALLED BY THE FOLLOWING SUBROUTINES.                    00033
C                                                                       00034
C         CVPROP    GEOS    GEOSY    GUIDE    MODE2                     00035
C                                                                       00036
C                                                                       00037
C                                                                       00038
C     THE FOLLOWING SUBROUTINES ARE CALLED BY RANDOM.                   00039
C                                                                       00040
C         MTRPLY                                                        00041
C                                                                       00042
C                                                                       00043
C                                                                       00044
C     THE FOLLOWING FUNCTION SUBPROGRAMS ARE CALLED BY RANDOM.          00045
C                                                                       00046
C         BARN1                                                         00047
C                                                                       00048
C                                                                       00049
C                                                                       00050
C     RANDOM NEITHER USES NOR ALTERS VARIABLES IN COMMON. ALL INPUT AND 00051
C         OUTPUT IS THROUGH THE CALLING SEQUENCE.                       00052
C                                                                       00053
C                                                                       00054
C                                                                       00055
      IMPLICIT REAL*8(A-H,O-Z)                                          00056
      DIMENSION EV(6,6),E(6),XB(6),XC(6),A(6)                           00057
      DIMENSION B(6)                                                    00058
      DO 150 I = 1,6                                                    00059
      SD = 0.D0                                                         00060
      IF (E(I).GT.0.D0) SD=DSQRT(E(I))                                  00061
C  THE A(I) ARRAY CONTAINS RANDOM NUMBERS COMPUTED FROM AN              00062
C  APPROXIMATE GAUSSIAN DISTRIBUTION.                                   00063
      A(I) =BARN1(-1,IKEY,IFRN,SD)                                      00064
  150 CONTINUE                                                          00065
C  MATRIX B IS COMPUTED BY MULTIPLYING MATRIX EV BY MATRIX A.           00066
      CALL MTRPLY (EV,A,B,6,6,1,6,6,6)                                  00067
      DO 160 I = 1,6                                                    00068
C  XC IS THE STATE VECTOR WITH ERRORS ADDED.                            00069
      XC(I) = XB(I)+B(I)                                                00070
  160 CONTINUE                                                          00071
      RETURN                                                            00072
      END                                                               00073
C          DATA SET RANDU      AT LEVEL 002 AS OF 06/22/79
C          DATA SET RANDU      AT LEVEL 001 AS OF 04/04/78              00001
C                                                                       00002
      SUBROUTINE RANDU(/IX/,IY,YFL)                                     00003
C                                                                       00004
C                                                                       00005
C     SUBROUTINE RANDU (IX,IY,YFL)                                      00006
C                                                                       00007
C                                                                       00008
C                                                                       00009
C     THE PURPOSE OF RANDU IS TO CALCULATE A RANDOM NUMBER BETWEEN 0 AND00010
C         1 FROM A NORMAL DISTRIBUTION.                                 00011
C                                                                       00012
C                                                                       00013
C                                                                       00014
C     ARGUMENTS IN THE CALLING SEQUENCE ARE  EFINED AS FOLLOWS.         00015
C                                                                       00016
C         ARGUMENT   TYPE    I/O        DEFINITION                      00017
C                                                                       00018
C          IX        I*4      I      PREVIOUS RANDOM NUMBER             00019
C          IY        I*4      O      INTERMEDIATE NUMBER (CAN BE GREATER00020
C                                       THAN 1)                         00021
C          YFL       R*8      O      RANDOM NUMBER BETWEEN 0 AND 1      00022
C                                                                       00023
C                                                                       00024
C                                                                       00025
C     RANDU IS CALLED BY THE FOLLOWING SUBROUTINES.                     00026
C                                                                       00027
C         BARN1     GAUSS                                               00028
C                                                                       00029
C                                                                       00030
C                                                                       00031
C     NO SUBROUTINES ARE CALLED BY RANDU.                               00032
C                                                                       00033
C                                                                       00034
C                                                                       00035
C     RANDU NEITHER USES NOR ALTERS VARIABLES IN COMMON. ALL INPUT AND  00036
C         OUTPUT IS THROUGH THE CALLING SEQUENCE.                       00037
C                                                                       00038
C                                                                       00039
C  THE UNIFORMLY DISTRIBUTED SET OF RANDOM NUMBERS IS GENERATED BY THE  00040
C  POWER SERIES RESIDUE METHOD.                                         00041
      IMPLICIT REAL*8(A-H,O-Z)                                          00042
      DATA JJJ5/1027/                                                   00043
      IY=IX*JJJ5                                                        00044
      IF(IY) 5,6,6                                                      00045
C  IY=IY + 2**31                                                        00046
    5 IY=IY+2147483647+1                                                00047
    6 YFL=IY                                                            00048
      YFL=YFL*.4656613D-9                                               00049
      RETURN                                                            00050
      END                                                               00051
C          DATA SET RANTAR     AT LEVEL 003 AS OF 06/22/79
C          DATA SET RANTAR     AT LEVEL 002 AS OF 05/31/79              00001
C          DATA SET RANTAR     AT LEVEL 001 AS OF 04/04/78              00002
      SUBROUTINE RANTAR(X2,XT,TF,SB,DV,DT2,XMU,ANG)                     00003
C                                                                       00004
C                                                                       00005
C  SUBROUTINE RANTAR(X2,XT,TF,SB,DV,DT2,XMU,ANG)                        00006
C                                                                       00007
C  SUBROUTINE RANTAR COMPUTES THE FINAL (TARGET) POSITION AND           00008
C  VELOCITY VECTOR, WITH ERRORS                                         00009
C                                                                       00010
C  ARGUMENTS IN THE CALLING SEQUENCE ARE DEFINED AS FOLLOWS             00011
C                                                                       00012
C  ARGUMENT  TYPE  I/O    DEFINITION                                    00013
C                                                                       00014
C     X2     R*8    I    RADIUS AND VELOCITY VECTOR OF INITIAL POINT    00015
C     XT     R*8    I    RADIUS AND VELOCITY VECTOR OF FINAL POINT      00016
C     TF     R*8    I    TIME BETWEEN INITIAL AND FINAL POINTS          00017
C     SB     R*8    I    DESIRED STANDARD DEVIATION FOR A               00018
C                        GAUSSIAN DISTRIBUTION                          00019
C     DV     R*8    O    MAGNITUDE OF DELTA-VELOCITY                    00020
C     DT2    R*8    I    INCREMENTAL TIME                               00021
C     XMU    R*8    I    GRAVITATIONAL CONSTANT FOR THE PARENT BODY     00022
C     ANG    R*8    O    ANGLE BETWEEN THE DELTA-V VECTOR AND THE       00023
C                        ANGULAR MOMENTUM VECTOR                        00024
C                                                                       00025
C  RANTAR IS CALLED BY THE FOLLOWING SUBROUTINE:                        00026
C                                                                       00027
C     MODE2                                                             00028
C                                                                       00029
C  RANTAR CALLS THE FOLLOWING SUBROUTINES:                              00030
C                                                                       00031
C   ADOT BARN1 CONBR CROSS FNORM MTRPLY STEPD TFY VELASY                00032
C                                                                       00033
C  RANTAR NEITHER USES NOR ALTERS VARIABLES IN COMMON.  ALL INPUT       00034
C  AND OUTPUT IS THROUGH THE CALLING SEQUENCE.                          00035
C                                                                       00036
C                                                                       00037
      IMPLICIT REAL*8(A-H,O-Z)                                          00038
      DIMENSION X2(6),XT(6),SB(3),XI(6),XO(8),CP(3),AUX(3),T50(6,4),    00039
     2 VC(6),VB(6),DV1(3)                                               00040
      DATA RTD/57.2957795130823208767D0/,TPI/6.2831853071795864769D0/   00041
      DATA AUX/0.D0,0.D0,1.D0/                                          00042
      KEY = 2                                                           00043
      XI(1) = FNORM(X2)                                                 00044
      XI(2) = FNORM(XT)                                                 00045
C  COMPUTE THE CENTRAL ANGLE BETWEEN THE TWO RADIUS VECTORS.            00046
      PSII = ADOT(X2,XT)/RTD                                            00047
      CALL CROSS(X2,XT,CP)                                              00048
      IF (DOT(CP,AUX).LE.0.D0) PSII = TPI-PSII                          00049
      XI(3) = PSII                                                      00050
      XI(4) = TF                                                        00051
      XI(5) = XMU                                                       00052
C  XI(6) GIVES THE TIMING ERROR                                         00053
      XI(6) = .00000001D0                                               00054
C  CONBR DETERMINES THE CONIC SECTION WHICH PASSES THROUGH THE          00055
C  GIVEN INITIAL AND FINAL POINTS, IN TIME TF.                          00056
      CALL CONBR (XI,XO,KEY)                                            00057
C  COMPUTE THE VELOCITY VECTOR WITH RESPECT TO THE CENTRAL BODY AT      00058
C  BODY 1, VC(1-3), AND AT BODY 2, VC(4-6).                             00059
      CALL VELASY (X2,XT,XO,VC,VB)                                      00060
      DO 20 I = 1,3                                                     00061
C  COMPUTE THE DELTA-V VECTOR, DV1.  THE VECTOR, DV1, EQUALS THE        00062
C  DIFFERENCE BETWEEN THE VELOCITY VECTOR, WITH RESPECT TO THE          00063
C  CENTRAL BODY, AT BODY 1 AND THE VELOCITY OF BODY 2 WITH RESPECT      00064
C  TO THE CENTRAL BODY.                                                 00065
      DV1(I) = VC(I)-X2(I+3)                                            00066
   20 CONTINUE                                                          00067
      CALL CROSS (X2,X2(4),CP)                                          00068
      ANG = ADOT(CP,DV1)                                                00069
      DV = FNORM(DV1)                                                   00070
C  THE NEXT THREE STATEMENTS COMPUTE THE (RANDOMLY) ERRORED VALUES      00071
C  FOR DELTA-V, PITCH, AND YAW.                                         00072
      DVK = BARN1(-1,-1,12787,SB(1)*DV)                                 00073
      PK  = BARN1(-1,-1,12787,SB(2))/RTD                                00074
      YK  = BARN1(-1,-1,12787,SB(3))/RTD                                00075
      CP(1) = DVK*DCOS(YK)*DCOS(PK)                                     00076
      CP(2) = -DVK*DCOS(YK)*DSIN(PK)                                    00077
      CP(3) = DVK*DSIN(YK)                                              00078
      CALL TFY (X2,DV1  ,T50)                                           00079
      CALL MTRPLY (T50,CP,DV1,3,3,1,6,3,3)                              00080
      DO 30 I = 1,3                                                     00081
C  COMPUTE THE VELOCITY VECTOR WITH RESPECT TO THE CENTRAL BODY AT      00082
C  BODY 1, WITH ERRORS.                                                 00083
      VC(I) = VC(I)+DV1(I)                                              00084
      CP(I) = X2(I)                                                     00085
   30 CONTINUE                                                          00086
      NSD = 1                                                           00087
      CALL STEPD(NSD,DT2,TA,CP,VC,XMU,X2,X2(4),1,T50)                   00088
      RETURN                                                            00089
      END                                                               00090
C          DATA SET SARA       AT LEVEL 001 AS OF 04/04/78              00000000
      SUBROUTINE SARA(W,ALPHA,BETA,NCONF)                               00000010
C                                                                       00000020
C                                                                       00000030
C     SUBROUTINE SARA (W,ALPHA,BETA,NCONF                               00000040
C                                                                       00000050
C                                                                       00000060
C                                                                       00000070
C     THE PURPOSE OF SARA IS TO COMPUTE THE SATELLITE ANGLES OF RIGHT   00000080
C         ASCENSION AND DECLINITION.                                    00000090
C                                                                       00000100
C                                                                       00000110
C                                                                       00000120
C     ARGUMENTS IN THE CALLING SEQUENCE ARE DEFINED AS FOLLOWS.         00000130
C                                                                       00000140
C         ARGUMENT   TYPE    I/O        DEFINITION                      00000150
C                                                                       00000160
C          W(3)      R*8      I      SPIN AXIS ORIENTATION VECTOR       00000170
C          ALPHA     R*8      O      SPIN AXIS RIGHT ASCENSION          00000180
C          BETA      R*8      O      SPIN AXIS DECLINATION              00000190
C                                                                       00000200
C                                                                       00000210
C                                                                       00000220
C     SARA IS CALLED BY THE FOLLOWING SUBROUTINES .                     00000230
C                                                                       00000240
C         PREP                                                          00000250
C                                                                       00000260
C                                                                       00000270
C                                                                       00000280
C     NO SUBROUTINES ARE CALLED BY SARA.                                00000290
C                                                                       00000300
C                                                                       00000310
C                                                                       00000320
C     SARA NEITHER USES NOR ALTERS VARIABLES IN COMMON. ALL INPUT AND   00000330
C         OUTPUT IS THROUGH THE CALLING SEQUENCE.                       00000340
C                                                                       00000350
C                                                                       00000360
C                                                                       00000370
      IMPLICIT REAL*8(A-H,O-Z)                                          00000380
      DATA PI/3.14159265D0/                                             00000390
      DIMENSION W(3)                                                    00000400
C                                                                       00000410
C     COMPUTE SATELLITE ANGLE OF RIGHT ASCENSION                        00000420
C                                                                       00000430
C     DETERMINATION OF WHETHER OR NOT ATAN(W(2)/W(1)) IS CLOSE TO + OR -00000440
C     90 DEGREES, I.E., WHETHER W(1) IS IN THE NEIGHBORHOOD             00000450
C     (NON-DELETED) OF ZERO                                             00000460
C                                                                       00000470
C     W(3) -I- SPIN AXIS ORIENTATION VECTOR                             00000480
C     ALPHA -O- RIGHT ASCENSION                                         00000490
C     BETA -O- DECLINATION                                              00000500
C                                                                       00000510
      IF(DABS(W(1)).LT.(1.0D-9))  GO TO 150                             00000520
      GO TO 151                                                         00000530
  150 ALPHA = PI/ 2.D0                                                  00000540
      IF(W(1).LT.0.0D0)ALPHA = -ALPHA                                   00000550
      GO TO 152                                                         00000560
  151 CONTINUE                                                          00000570
C                                                                       00000580
      ALPHA = DATAN2(W(2),W(1))                                         00000590
  152 CONTINUE                                                          00000600
C                                                                       00000610
C                                                                       00000620
C     COMPUTE DECLINATION ANGLE                                         00000630
C                                                                       00000640
      BETA = DARSIN(W(3))                                               00000650
      IF(NCONF.EQ.1)GO TO 990                                           00000660
      WRITE(6,366)ALPHA,BETA                                            00000670
  366 FORMAT(20X,'RIGHT ASCENSION=',F10.4,5X,'DECLINATION=',F10.4)      00000680
  990 CONTINUE                                                          00000690
      RETURN                                                            00000700
      END                                                               00000710
C          DATA SET SCAN       AT LEVEL 017 AS OF 06/29/79
C          DATA SET SCAN       AT LEVEL 015 AS OF 03/15/79              00001
C          DATA SET SCAN       AT LEVEL 009 AS OF 02/09/79              00002
C          DATA SET SCAN       AT LEVEL 003 AS OF 01/22/79              00003
      SUBROUTINE SCAN                                                   00004
C                                                                       00005
C       SUBROUTINE SCAN                                                 00006
C                                                                       00007
C       THE PURPOSE OF SCAN IS TO READ IN INITIAL AND FINAL VALUES      00008
C       OF THE DESIRED VARIABLE (TO BE SCANNED) AND THE INCREMENT.      00009
C                                                                       00010
C       THERE ARE NO ARGUMENTS IN THE CALLING SEQUENCE.                 00011
C                                                                       00012
C                                                                       00013
C       SCAN IS CALLED BY THE FOLLOWING SUBROUTINES:                    00014
C                                                                       00015
C          MAIN                                                         00016
C                                                                       00017
C       THE FOLLOWING SUBROUTINES ARE CALLED BY SCAN:                   00018
C                                                                       00019
C          GEOSY, CONVRT                                                00020
C                                                                       00021
C       THE VARIABLES APPEARING IN COMMON BLOCK ARE TABULATED BELOW:    00022
C                                                                       00023
C       COMMON BLOCK VARIABLES USED                                     00024
C                                                                       00025
C          EL, ISCAN, SCNPAR                                            00026
C                                                                       00027
C       COMMON BLOCK VARIABLES COMPUTED                                 00028
C                                                                       00029
C          AIS,AKMWT,DECPKM,DELNOI,DVINI,DVINJ,PITCHI,RAPKM,            00030
C          TAKMAN,TAMAN,WAPKM,YAWI                                      00031
C                                                                       00032
C       THE MEANINGS OF THE VARIABLE NAMES ARE                          00033
C                                                                       00034
C         DVINJ=PKM DELTA V                                             00035
C         WAPKM=WEIGHT AFTER PKM MANEUVER                               00036
C         RAPKM=RIGHT ASCENSION AT PERIGEE KICK MOTOR PHASE             00037
C         DECPKM=DECLINATION AT PERIGEE KICK MOTOR PHASE                00038
C         ELEM(1)=SEMI MAJOR AXIS                                       00039
C         ELEM(2)=ECCENTRICITY                                          00040
C         ELEM(4)=LONGITUDE OF ASCENDING NODE                           00041
C         ELEM(5)=INCLINATION                                           00042
C                                                                       00043
C                                                                       00044
C       TAMAN=MANUAL TRUE ANOMALY                                       00045
C       DELNOI=REQUIRED INPUT NODE ROTATION                             00046
C       DVINI=AKM DELTA V                                               00047
C       AKMWT=AKM WEIGHT OF SPACECRAFT AFTER FUEL BURN                  00048
C       PITCHI=PITCH OF THE VEHICLE BEFORE ABM BURN                     00049
C       YAWI=YAW OF THE VEHICLE BEFORE ABM BURN                         00050
C       EL=INITIAL ORBITAL ELEMENTS                                     00051
C        ISCAN=TELLS WHICH VARIABLE IS TO BE SCANNED                    00052
C        SCNPAR=GIVES INITIAL, FINAL, AND INCREMENT VALUES FOR          00053
C        EACH VARIABLE TO BE SCANNED.                                   00054
                                                                        00055
      IMPLICIT REAL*8(A-H,O-Z)                                          00056
       REAL*8 NAMES                                                     00057
       REAL*4 ZDELT,ZUB                                                 00058
      COMMON/PKMCOM/XISPJ,DVINJ,DECPKM,RAPKM,TERRJ,SIGBJ(2),            00059
     1 DELNOJ,AINSYJ,ASJ,TAM,LEGJ,IGUIDJ,ITO,JPKM                       00060
      COMMON/GEO/AINSYI,AINTRI,AIS,ALAMDI,ANOM,AP,AS,ASM,DELNOI,        00061
     1DRTOL,DSMA,DVINI,DVNI,EL(6),ES,ESM,SDAY,SNODE,STAFI,TCOV,         00062
     2TAMAN,TERR,TUB,WAH,XB(6),XISPH,XISPI,DIS,FIS,DNS,FNS,ALI,         00063
     3ALF,ALD,IGUIDI,IOP,IW,LEG,IFLAG,ITOPT,ISCFLG, SCNPAR(3,5)         00064
      COMMON/GENRL/P1,PI(6,6),XII(6),XMU,NAMES(6),PITCHI,YAWI,          00065
     1WI,P1I(6,6),P2I(6,6),P3I(6,6),P4I(6,6),P5I(6,6),P6I(6,6),         00066
     2TOLR(50),THRUSI,SIGBI(3),ZDELT,ZUB(3,50),IP1COR,IP2COR,           00067
     3IP3COR,IP4COR,IP5COR,IP6COR,ICOV(50),IHIST(50),IPCOOR,            00068
     4ITPSTR,NCONF,MODE,IKEY,IFRN                                       00069
      COMMON/TSCAN/WAPKM,TAKMAN,AKMWT,ISCANT(50),IUP,ISCAN(5)           00070
      COMMON/LSCAN/LUNIT                                                00071
       COMMON/SCNTY/TITLE(16),VAR(5)                                    00072
      DIMENSION N(5),ELEM(6)                                            00073
      EQUIVALENCE (N(1),N1),(N(2),N2),(N(3),N3),(N(4),N4),(N(5),N5)     00074
      DATA N/5*1/                                                       00075
C  OBTAIN SCAN RANGES                                                   00076
      DO 1 I=1,5                                                        00077
      IF(SCNPAR(3,I).EQ.0.D0) GO TO 1                                   00078
      N(I)=(SCNPAR(2,I)-SCNPAR(1,I))/SCNPAR(3,I) + 1.5D0                00079
    1 CONTINUE                                                          00080
C  START DO LOOPS FOR SCAN                                              00081
      DO 500 I5=1,N5                                                    00082
      VAR(5)=CONVRT(SCNPAR(1,5),I5)                                     00083
      DO 400 I4=1,N4                                                    00084
      VAR(4)=CONVRT(SCNPAR(1,4),I4)                                     00085
      DO 300 I3=1,N3                                                    00086
      VAR(3)=CONVRT(SCNPAR(1,3),I3)                                     00087
      DO 200 I2=1,N2                                                    00088
      VAR(2)=CONVRT(SCNPAR(1,2),I2)                                     00089
      DO 100 I1=1,N1                                                    00090
      VAR(1)=CONVRT(SCNPAR(1,1),I1)                                     00091
C  RETRIEVE INITIAL ELEMENTS                                            00092
      DO 2 I=1,6                                                        00093
    2 ELEM(I)=EL(I)                                                     00094
C  CHANGE PARAMETERS TO BE SCANNED                                      00095
      DO 3 I=1,5                                                        00096
      J=ISCAN(I)                                                        00097
      IF(J.EQ.0) GO TO 3                                                00098
      IF(J.LT.0.OR.J.GT.17) GO TO 998                                   00099
      GO TO(11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,3),J        00100
   11 DVINJ=VAR(I)                                                      00101
      GO TO 3                                                           00102
   12 WAPKM=VAR(I)                                                      00103
      GO TO 3                                                           00104
   13 RAPKM=VAR(I)                                                      00105
      GO TO 3                                                           00106
   14 DECPKM=VAR(I)                                                     00107
      GO TO 3                                                           00108
   15 ELEM(1)=VAR(I)                                                    00109
      GO TO 3                                                           00110
   16 ELEM(2)=VAR(I)                                                    00111
      GO TO 3                                                           00112
   17 ELEM(5)=VAR(I)                                                    00113
      GO TO 3                                                           00114
   18 TAMAN=VAR(I)                                                      00115
      GO TO 3                                                           00116
   19 ELEM(4)=VAR(I)                                                    00117
      GO TO 3                                                           00118
   20 DELNOI=VAR(I)                                                     00119
      GO TO 3                                                           00120
   21 DVINI=VAR(I)                                                      00121
      GO TO 3                                                           00122
   22 TAKMAN=VAR(I)                                                     00123
      GO TO 3                                                           00124
   23 AKMWT=VAR(I)                                                      00125
      GO TO 3                                                           00126
   24 PITCHI=VAR(I)                                                     00127
      GO TO 3                                                           00128
   25 YAWI=VAR(I)                                                       00129
      GO TO 3                                                           00130
   26 AINSYI=VAR(I)                                                     00131
    3 CONTINUE                                                          00132
C  CALL GEOS                                                            00133
      CALL GEOSY                                                        00134
  100 CONTINUE                                                          00135
  200 CONTINUE                                                          00136
  300 CONTINUE                                                          00137
  400 CONTINUE                                                          00138
  500 CONTINUE                                                          00139
      GO TO 999                                                         00140
  998 WRITE(LUNIT,3000) I,ISCAN(I)                                      00141
 3000 FORMAT('1** ISCAN(',I1,') = ',I5,' IS OUT OF RANGE 1-16.**')      00142
  999 RETURN                                                            00143
      END                                                               00144
      DOUBLE PRECISION FUNCTION CONVRT(A,K)                             00145
C                                                                       00146
C  DOUBLE PRECISION FUNCTION CONVRT(A,K)                                00147
C                                                                       00148
C  CONVRT DETERMINES THE VALUE OF THE VARIABLE CORRESPONDING TO THE     00149
C  K-TH INTERVAL WITHIN THE RANGE.                                      00150
C                                                                       00151
C  ARGUMENTS IN THE CALLING SEQUENCE ARE DEFINED AS FOLLOWS:            00152
C                                                                       00153
C  ARGUMENT  TYPE  I/O    DEFINITION                                    00154
C                                                                       00155
C     A      R*8    I    AN ARRAY CONTAINING THE INITIAL AND FINAL      00156
C                        VALUES OF THE VARIABLE, AND THE INCREMENT      00157
C     K      I*4    I    INDICATES WHICH INTERVAL IS UNDER CONSIDERATION00158
C   CONVRT   R*8    O    GIVES THE VALUE OF THE VARIABLE FOR THE K-TH   00159
C                        INTERVAL                                       00160
C                                                                       00161
C  CONVRT IS CALLED BY THE FOLLOWING SUBROUTINE:                        00162
C                                                                       00163
C     SCAN                                                              00164
C                                                                       00165
C  CONVRT CALLS NO SUBROUTINES                                          00166
C                                                                       00167
C  CONVRT NEITHER USES NOR ALTERS VARIABLES IN COMMON. ALL INPUT AND    00168
C  OUTPUT IS THROUGH THE CALLING SEQUENCE.                              00169
C                                                                       00170
C                                                                       00171
      REAL*8 A(3)                                                       00172
      CONVRT=A(1)+(K-1.D0)*A(3)                                         00173
      RETURN                                                            00174
      END                                                               00175
C          DATA SET SCOUT      AT LEVEL 011 AS OF 03/02/79              00000010
C          DATA SET SCOUT      AT LEVEL 007 AS OF 02/12/79              00000020
C     SUBROUTINE SCOUT(B,ELT,ELTU)                                      00000030
       SUBROUTINE SCOUT(B,ELT,ELTU)                                     00000040
C                                                                       00000050
C      SUBROUTINE SCOUT(B,ELT,ELTU)                                     00000060
C                                                                       00000070
C                                                                       00000080
C      THE PURPOSE OF SCOUT IS TO OUTPUT THE ORBITAL PARAMETERS         00000090
C      IN THE DESIRED FORM IN THE SCAN MODE                             00000100
C                                                                       00000110
C      ARGUMENTS IN THE CALLING SEQUENCE ARE DEFINED AS FOLLOWS:        00000120
C                                                                       00000130
C       ARGUMENT  TYPE  I/O            DEFINITION                       00000140
C          B      R*8    I       VALUE OF THE ORBITAL PARAMETER         00000150
C          ELT    R*8    I       TITLE OR NAME OF THE ORBITAL PARAMETER 00000160
C          ELTU   R*8    I       UNITS OF THE ORBITAL PARAMETER         00000170
C                                                                       00000180
C       SCOUT IS CALLED BY THE FOLLOWING SUBROUTINES:                   00000190
C          GEOSY                                                        00000200
C                                                                       00000210
C       NO SUBROUTINES ARE CALLED BY SCOUT                              00000220
C                                                                       00000230
C       THE VARIABLES APPEARING IN COMMON BLOCKS ARE TABULATED BELOW    00000240
C                                                                       00000250
C       COMMON VARIABLES USED                                           00000260
C                                                                       00000270
C       ISCANT, IUP                                                     00000280
C                                                                       00000290
C       COMMON VARIABLES USED AND COMPUTED                              00000300
C       LUNIT                                                           00000310
       IMPLICIT REAL*8 (A-H,O-Z)                                        00000320
C       IF MORE THAN 9 VARIABLES ARE TO BE OUTPUT, JCL MUST BE          00000330
C       PROVIDED FOR ANY ADDITIONAL PRINTER UNITS.                      00000340
       DIMENSION  SIGNIF( 9),UNIT( 9),VARB( 9)                          00000350
C       B=VALUE OF ORBITAL PARAMETER, ELT AND ELTU ARE THE NAME         00000360
C       OF THE PARAMETER AND THE UNITS FOR THE PARAMETER.               00000370
       DIMENSION  B(1),ELT(1),ELTU(1)                                   00000380
C       ISCANT IS AN INDEX THAT SPECIFIES WHICH ORBITAL PARAMETER       00000390
C       IS BEING CONSIDERED.  WHEN ISCANT=0, THE REST OF THE LIST       00000400
C       OF PARAMETERS IS SKIPPED.                                       00000410
       COMMON/TSCAN/ WAPKM,TAKMAN,AKMWT,ISCANT(50),IUP,ISCAN(5)         00000420
      COMMON/SCNTY/TITLE(16),VAR(5)                                     00000430
       COMMON/LSCAN/LUNIT                                               00000440
       ICANT=0                                                          00000450
       LUNIT1=LUNIT                                                     00000460
C       THE DO LOOP ALLOWS A MAXIMUM OF 100 PARAMETERS TO BE PROCESSED. 00000470
       DO 800 I=1,100                                                   00000480
        IF(ISCANT(I).EQ.0.AND.ICANT.EQ.0)GOTO 990                       00000490
C       THE NEXT STATEMENT CHECKS TO SEE IF ALL OF THE PARAMETERS       00000500
C       DESIRED HAVE BEEN ACTED UPON (ISCANT=0 SIGNALS THE END HAS      00000510
C       BEEN REACHED).                                                  00000520
       IF(ISCANT(I).EQ.0) GOTO 860                                      00000530
       ICANT=ICANT+1                                                    00000540
       GOTO (805,810),IUP                                               00000550
C       SIGNIF, UNIT, AND VARB ARE THE NAME, UNITS, AND VALUE OF        00000560
C       THE ORBITAL PARAMETER.                                          00000570
  805  SIGNIF(ICANT)= ELT(ISCANT(I))                                    00000580
       UNIT(ICANT)= ELTU(ISCANT(I))                                     00000590
  810  VARB(ICANT)=B(ISCANT(I))                                         00000600
C       CHECKING ICANT=9 IS NECESSARY SINCE A MAXIMUM OF 9              00000610
C       VARIABLES ARE PRINTED ON ONE PRINTER UNIT.                      00000620
       IF(ICANT.EQ. 9)  GOTO 860                                        00000630
C       THIS STATEMENT CHECKS TO SEE IF ALL 100 PARAMETERS HAVE         00000640
C       BEEN STUDIED.                                                   00000650
       IF(I.EQ.100) GOTO 860                                            00000660
       GOTO 800                                                         00000670
C       THE NEXT STATEMENT DETERMINES WHETHER OR NOT THE TITLE AND      00000680
C       UNIT DESIGNATION OF THE PARAMETER NEED TO BE PRINTED            00000690
  860  IF(IUP) 865,865,870                                              00000700
  865  WRITE(LUNIT,910) (SIGNIF(IJ),IJ=1,ICANT)                         00000710
       WRITE(LUNIT,915) (UNIT(IK),IK=1,ICANT)                           00000720
C      PRINTING OUT THE INITIAL SCAN VARIABLES.                         00000730
  870      WRITE(LUNIT,1000)                                            00000740
       DO 840 IJ=1,5                                                    00000750
       IF(ISCAN(IJ).GT.16.OR.ISCAN(IJ).LT.1) GO TO 840                  00000760
       WRITE(LUNIT,2000) TITLE(ISCAN(IJ)),VAR(IJ)                       00000770
  840  CONTINUE                                                         00000780
       WRITE(LUNIT,920) (VARB(IZ),IZ=1,ICANT)                           00000790
       IF(ISCANT(I).EQ.0.OR.I.EQ.100) GO TO 990                         00000800
C       THE NEXT STATEMENT INDEXES THE PRINTER UNIT.                    00000810
       LUNIT=LUNIT+1                                                    00000820
       ICANT=0                                                          00000830
       GOTO 800                                                         00000840
  910  FORMAT(' ',9(2X,A8,4X))                                          00000850
  915  FORMAT(' ',A8,4X,8(2X,A8,4X),/)                                  00000860
  920  FORMAT(' ',9(D13.6,1X),/)                                        00000870
 1000 FORMAT('     INITIAL SCAN VARIABLES:')                            00000880
 2000 FORMAT(4X,A8,'=',G15.8)                                           00000890
  800  CONTINUE                                                         00000900
C       THE NEXT TWO STATEMENTS INITIALIZE IUP AND LUNIT FOR            00000910
C       THE NEXT CALL STATEMENT.                                        00000920
  990  IUP=1                                                            00000930
       LUNIT=LUNIT1                                                     00000940
       RETURN                                                           00000950
       END                                                              00000960
C          DATA SET STATS      AT LEVEL 004 AS OF 06/25/79
C          DATA SET STATS      AT LEVEL 003 AS OF 10/31/78              00001
      SUBROUTINE STATS(LUTP,ELT,IHFLG,NP,TITLE,ZBH,C2)                  00002
C                                                                       00003
C                                                                       00004
C     SUBROUTINE STATS (LUTP,ELT,IHFLG,NP,TITLE,ZBH,C2)                 00005
C                                                                       00006
C                                                                       00007
C                                                                       00008
C     THE PURPOSE OF STATS IS TO COMPUTE AND OUTPUT ALL STATISTICAL     00009
C         INFORMATION FROM THE SAMPLE DATA STORED ON FORTRAN UNIT LU20. 00010
C                                                                       00011
C                                                                       00012
C                                                                       00013
C     ARGUMENTS IN THE CALLING SEQUENCE ARE DEFINED AS FOLLOWS.         00014
C                                                                       00015
C         ARGUMENT   TYPE    I/O        DEFINITION                      00016
C                                                                       00017
C          LUTP      I*4      I      DUMMY PARAMETER (NOT USED)         00018
C          ELT(25)   R*8      I      ARRAY OF TITLES FOR OUTPUT         00019
C                                     PARAMETERS                        00020
C          IHFLG     I*4      I      IHFLG=1, DO NOT READ SAMPLE DATA;  00021
C                                     USE NOMINAL DATA ONLY IHFLG .NE. 100022
C                                     READ SAMPLE DATA                  00023
C          NP        I*4      I      NUMBER OF SAMPLES ON UNIT LU20     00024
C          TITLE(10) R*8      I      TITLE TO BE OUTPUT AS FIRST LINE   00025
C                                     ABOVE ALL HISTOGRAM DATA          00026
C          ZBH(20000)R*8      I      SAMPLE DATA READ FROM UNIT LU20    00027
C          C2(25)    R*8     I/O     NOMINAL VALUE OF TRAJECTORY        00028
C                                     PARAMETER                         00029
C                                                                       00030
C                                                                       00031
C                                                                       00032
C     STATS IS CALLED BY THE FOLLOWING SUBROUTINES.                     00033
C                                                                       00034
C         MAIN                                                          00035
C                                                                       00036
C                                                                       00037
C                                                                       00038
C     THE FOLLOWING SUBROUTINES ARE CALLED BY STATS.                    00039
C                                                                       00040
C         ARRANG    HISTO     M2STAT    TAB1      TOLER                 00041
C                                                                       00042
C                                                                       00043
C                                                                       00044
C     THE VARIABLES APPEARING IN COMMON BLOCKS ARE TABULATED BELOW.     00045
C                                                                       00046
C         COMMON VARIABLES USED                                         00047
C                                                                       00048
C                                                                       00049
C         ICOV      IHIST     ITPSTR    LV20      TOLR      ZVB         00050
C                                                                       00051
C                                                                       00052
C                                                                       00053
      IMPLICIT REAL*8(A-H,O-Y)                                          00054
      REAL*8 NAMES,ZB                                                   00055
      COMMON/LUS/LU8,LU9,LU16,LU20                                      00056
      DIMENSION ZPCT(51),ZSTATS(5),TITLE(10),ZB(50),ZBH(10000),C2(50)   00057
      DIMENSION ZFREQ(50),ZX(50),ZELT(50),DELP(9),ELT(50),TESTP(9)      00058
      COMMON /GENRL/ P1,PI(6,6),XII(6),XMU,NAMES(6),PITCHI,YAWI,WI,     00059
     A P1I(6,6),P2I(6,6),P3I(6,6),P4I(6,6),P5I(6,6),P6I(6,6),TOLR(50),  00060
     * THRUSI,SIGBI(3),ZDELT,ZUB(3,50),                                 00061
     B IP1COR,IP2COR,IP3COR,IP4COR,IP5COR,IP6COR,                       00062
     1           ICOV(50),IHIST(50),IPCOOR,ITPSTR,NCONF,MODE            00063
     2 ,IKEY,IFRN                                                       00064
      DATA TESTP /1.D0,5.D0,10.D0,30.D0,50.D0,70.D0,90.D0,95.D0,99.D0/  00065
C  COMPUTE OUTPUT COVARIANCE MATRIX                                     00066
      CALL M2STAT(LUTP,ICOV,NP,NOPT,ELT)                                00067
      IHST=0                                                            00068
      DO 250 I=1,50                                                     00069
      ITSTH=IHIST(I)                                                    00070
      L=IABS(IHIST(I))                                                  00071
C  L=0 OR L > 50 INDICATES NO HISTOGRAM IS DESIRED                      00072
      IF(L.EQ.0.OR.L.GT.50) GO TO 250                                   00073
      IHST=IHST+1                                                       00074
      IF(IHFLG.EQ.1) GO TO 210                                          00075
      REWIND LU20                                                       00076
      READ(LU20)ELT                                                     00077
C  READ NOMINAL VALUES FOR THE TRAJECTORY PARAMETER                     00078
      READ(LU20)C2                                                      00079
      NPP=ITPSTR+NP-1                                                   00080
      DO 205 IZ=ITPSTR,NPP                                              00081
      READ(LU20)ZB                                                      00082
      ZBH(IZ)=ZB(L)                                                     00083
  205 CONTINUE                                                          00084
      REWIND LU20                                                       00085
      IPT1=1                                                            00086
      GO TO 215                                                         00087
  210 IPT1=(IHST-1)*NP+1                                                00088
  215 CONTINUE                                                          00089
      ZELT(I) = C2(L)                                                   00090
      NZP = ZUB(2,I)                                                    00091
      NZX = NZP-1                                                       00092
C  COMPUTE PERCENT OF OCCURENCE FOR EACH INTERVAL OF THE HISTOGRAM      00093
C  (ZPCT) AND THE MEAN, STANDARD DEVIATION, AND MINIMUM AND MAXIMUM     00094
C  VALUES FOR THE PARAMETER (ZSTATS)                                    00095
      CALL TAB1(ZBH(IPT1),1.0,1,ZUB(1,I),ZFREQ,ZPCT,ZSTATS,NP,1)        00096
      Z1 = ZUB(1,I)                                                     00097
      Z3 = ZUB(3,I)                                                     00098
      IF (ZUB(3,I).GT.ZUB(1,I)) GO TO 220                               00099
      ZUB(1,I) = ZSTATS(4)                                              00100
      ZUB(3,I) = ZSTATS(5)                                              00101
C  ZDX GIVES THE NUMERICAL WIDTH (I.E., THE DELTA PARAMETER VALUE) OF AN00102
C  INTERVAL OF THE HISTOGRAM                                            00103
  220 ZDX = (ZUB(3,I)-ZUB(1,I))/(ZUB(2,I)-2.)                           00104
      ZX(1) = ZUB(1,I)                                                  00105
      DO 230 J = 2,NZX                                                  00106
      ZX(J) = ZX(J-1)+ZDX                                               00107
  230 CONTINUE                                                          00108
C  OUTPUT THE STATISTICAL DATA AND PLOT A HISTOGRAM, IF REQUESTED.      00109
      CALL HISTO(TITLE,ELT(L),ZPCT,ZX,ZSTATS(2),ZSTATS(3),NZP,ZELT(I),  00110
     1 NP,ITSTH,DELP,TESTP)                                             00111
      IF(TOLR(L).LE.0.D0) GO TO 240                                     00112
      WRITE(6,700) ELT(L)                                               00113
C  ARRANG AND TOLER ENABLE THE CONFIDENCE LIMITS TO BE COMPUTED         00114
      CALL ARRANG(ZBH(IPT1),NP)                                         00115
      DO 235 JJ=1,9                                                     00116
      CALL TOLER(NP,TESTP(JJ),DELP(JJ),TOLR(L),ZBH(IPT1),               00117
     1 ALPHA,XINF,XSUP)                                                 00118
  235 CONTINUE                                                          00119
  240 CONTINUE                                                          00120
      ZUB(1,I) = Z1                                                     00121
      ZUB(3,I) = Z3                                                     00122
  250 CONTINUE                                                          00123
  700 FORMAT('1',44X,A8,1X,'CONFIDENCE INTERVALS',//,16X,               00124
     1 'PERCENTILE',8X,'ESTIMATE',8X,'ALPHA',8X,'XINF',16X,'XSUP')      00125
      RETURN                                                            00126
      END                                                               00127
C          DATA SET STEPD      AT LEVEL 003 AS OF 06/22/79
C          DATA SET STEPD      AT LEVEL 002 AS OF 06/01/79              00001
C                                                                       00002
C                                                                       00003
C                                                                       00004
C                                                                       00005
C                                                                       00006
C                                                                       00007
C                                                                       00008
C                                                                       00009
C                                                                       00010
C                                                                       00011
C                                                                       00012
      SUBROUTINE STEPD(N,T,TA,R,V,U,RR,VV,M,SB)                         00013
C                                                                       00014
C                                                                       00015
C     SUBROUTINE STEPD (N,T,TA,R,V,U,RR,VV,M,SB)                        00016
C                                                                       00017
C                                                                       00018
C                                                                       00019
C     THE PURPOSE OF STEPD IS TO COMPUTE THE RADIUS AND VELOCITY VECTORS00020
C         OF A VEHICLE SEPARATED BY A TIME INCREMENT OR A CENTRAL ANGLE 00021
C         INCREMENT FROM THE INITIAL STATE ON EITHER AN ELLIPTIC OR A   00022
C         HYPERBOLIC ORBIT.                                             00023
C                                                                       00024
C                                                                       00025
C                                                                       00026
C     ARGUMENTS IN THE CALLING SEQUENCE ARE DEFINED AS FOLLOWS.         00027
C                                                                       00028
C         ARGUMENT   TYPE    I/O        DEFINITION                      00029
C                                                                       00030
C          N         I*4      I      INITIALIZING INDEX,                00031
C                                       =1, ESTABLISH INITIAL CONDITION 00032
C                                       VECTOR SB (FIRST CALL TO STEPD) 00033
C                                       =2, USE PREVIOUSLY CREATED      00034
C                                       VECTOR SB TO PROPAGATE TO A NEW 00035
C                                       POSITION ON THE ORBIT           00036
C          T         R*8     I/O     INCREMENTAL TIME                   00037
C          TA        R*8     I/O     CENTRAL ANGLE                      00038
C          R(3)      R*8      I      INITIAL POSITION ON THE CONIC      00039
C          V(3)      R*8      I      INITIAL VELOCITY ON THE CONIC      00040
C          U         R*8      I      GRAVITATIONAL CONSTANT             00041
C          RR(3)     R*8      O      POSITION ON CONIC AFTER TIME OR    00042
C                                       ANGULAR INCREMENT               00043
C          VV(3)     R*8      O      VELOCITY ON CONIC AFTER TIME OR    00044
C                                       ANGULAR INCREMENT               00045
C          M         I*4      I      STEP OPTION,                       00046
C                                       .GT.0, TIME INCREMENT           00047
C                                       .LE.0, CENTAL ANGLE INCREMENT   00048
C          SB(20)    R*8     I/O     STORAGE VECTOR                     00049
C                                       SB(1)=INITIAL TRUE ANOMALY      00050
C                                       SB(2)=SEMI-LATUS RECTUM         00051
C                                       SB(3)=ECCENTRICITY              00052
C                                       SB(4)=RADIUS SQUARED            00053
C                                       SB(5)=RADIUS MAGNITUDE (R)      00054
C                                       SB(6)=SEMI-MAJOR AXIS (A)       00055
C                                       SB(7)=ABSOLUTE VALUE OF A       00056
C                                       SB(8)=MEAN MOTION               00057
C                                       SB(9)=KEPLER'S EQUATION CONSTANT00058
C                                       SB(5)/SB(7)                     00059
C                                       SB(10)=KEPLER'S EQUATION        00060
C                                       CONSTANT, SB(14)                00061
C                                       SB(11)=ANGULAR MOMENTUM SQUARED 00062
C                                       (H2)                            00063
C                                       SB(12)=ANGULAR MOMENTUM         00064
C                                       MAGNITUDE (H)                   00065
C                                       SB(13)=MU TIMES RADIUS MAGNITUDE00066
C                                       (UR)                            00067
C                                       SB(14)=R DOT V                  00068
C                                       SB(15)=H2-UR                    00069
C                                       SB(16)=H*SB(14)                 00070
C                                       SB(17)=U/(R*H2)                 00071
C                                       SB(18)=RV/H                     00072
C                                       SB(19)=TIME FROM PERIAPSIS      00073
C                                       (+ OR -)                        00074
C                                       SB(20)=ORBIT FLAG,              00075
C                                       1=ELLIPTICAL, 2=HYPERBOLIC      00076
C                                                                       00077
C                                                                       00078
C                                                                       00079
C     STEPD IS CALLED BY THE FOLLOWING SUBROUTINES.                     00080
C                                                                       00081
C         GEOS     GEOSY    GUIDE     PREP     RANTAR                   00082
C                                                                       00083
C                                                                       00084
C                                                                       00085
C     THE FOLLOWING SUBROUTINES ARE CALLED BY STEPD.                    00086
C                                                                       00087
C         CROSS     GOTOR     TCONIC                                    00088
C                                                                       00089
C                                                                       00090
C                                                                       00091
C     THE FOLLOWING FUNCTION SUBPROGRAMS ARE CALLED BY STEPD.           00092
C                                                                       00093
C         ARKTNS    DOT                                                 00094
C                                                                       00095
C                                                                       00096
C                                                                       00097
C     STEPD NEITHER USES NOR ALTERS VARIABLES IN COMMON. ALL INPUT AND  00098
C         OUTPUT IS THROUGH THE CALLING SEQUENCE.                       00099
C                                                                       00100
C                                                                       00101
C                                                                       00102
C         CONIC WALKER BY SAMS METHOD                                   00103
C     CB IS A STORAGE VECTOR WHOSE ELEMENTS ARE                         00104
C     (1) INITIAL TRUE ANOMALY         (11) ANGULAR MOMENTUM SQUARED H2 00105
C     (2) SEMI-LATUS RECTUM            (12) ANGULAR MOMENTUM MAGNITUDE H00106
C     (3) ECCENTRICITY                 (13) MU TIMES RADIUS MAGNITUDE UR00107
C     (4) RADIUS-SQUARED               (14) R DOT V                     00108
C     (5) RADIUS MAGNITUDE             (15) H2-UR                       00109
C     (6) SEMI-MAJOR AXIS (A)          (16) H*RDOTV                     00110
C     (7) ABSOLUTE VALUE OF (A)        (17) U/(R*H2)                    00111
C     (8) MEAN MOTION                  (18) RV/H                        00112
C     (9) TIME COEFFICIENT  R/ABA      (19) TIME FROM PERIAPSIS (+ OR -)00113
C     (10)TIME COEFFICIENT RV/SQRT(UA) (20) SWITCH 1 ELLIP, 2 HYPER     00114
      IMPLICIT REAL*8(A-H,O-Z,$)                                        00115
      DIMENSION R(3),V(3),HVEC(3),RR(3),VV(3),F(4),CB(20)               00116
      DIMENSION SB(20)                                                  00117
      N=N                                                               00118
      GO TO (1,7),N                                                     00119
C  N=1 IS A SIGN THAT THE CB ARRAY NEEDS TO BE COMPUTED.  THE CB ARRAY  00120
C  CONTAINS ALL OF THE QUANTITIES REQUIRED IN THE SUBROUTINE'S          00121
C  INITIALIZATION CALCULATIONS.                                         00122
    1 CONTINUE                                                          00123
      PI=.314159265D+01                                                 00124
      TPI=.628318530D+01                                                00125
      CB(4)=DOT(R,R)                                                    00126
      CB(5)=DSQRT(CB(4))                                                00127
      V2=DOT(V,V)                                                       00128
      CB(14)=DOT(R,V)                                                   00129
      VM=DSQRT(V2)                                                      00130
C  CB(6) CONTAINS THE SEMI-MAJOR AXIS, FOUND FROM REARRANGING THE       00131
C  VIS VIVA EQUATION.                                                   00132
      CB(6)=CB(5)/(2.0D0-CB(5)*V2/U)                                    00133
      CB(7)=DABS(CB(6))                                                 00134
C  CB(8) IS THE MEAN MOTION, I.E., 2*PI/PERIOD                          00135
      CB(8)=DSQRT(U/CB(7))/CB(7)                                        00136
      CB(9)=CB(5)/CB(7)                                                 00137
      CB(10)=CB(14)/DSQRT(U*CB(7))                                      00138
      CALL CROSS(R,V,HVEC)                                              00139
      CB(11)=DOT(HVEC,HVEC)                                             00140
      CB(12)=DSQRT(CB(11))                                              00141
      CB(13)=U*CB(5)                                                    00142
      CB(2)=CB(11)/U                                                    00143
C  COMPUTE EC2, THE ECCENTRICITY SQUARED.                               00144
      EC2=1.0D0-CB(2)/CB(6)                                             00145
      IF(EC2.GE.(-1.D-6).AND.EC2.LE.0.D0) GO TO 200                     00146
      CB(3)=DSQRT(EC2)                                                  00147
      GO TO 201                                                         00148
  200 CB(3)=0.D0                                                        00149
  201 CONTINUE                                                          00150
      CB(15)=CB(11)-CB(13)                                              00151
      CB(16)=CB(12)*CB(14)                                              00152
      CB(17)=U/(CB(5)*CB(11))                                           00153
      CB(18)=CB(14)/CB(12)                                              00154
C  COMPUTE THE INITIAL TRUE ANOMALY.                                    00155
      CB(1)=ARKTNS(180,CB(15),CB(16))                                   00156
      TA2=CB(1)                                                         00157
      IF(CB(6))3,3,2                                                    00158
    2 CONTINUE                                                          00159
      CB(20)=1.0D0                                                      00160
      E1=CB(8)*T                                                        00161
      GO TO 4                                                           00162
    3 CONTINUE                                                          00163
      CB(20)=2.0D0                                                      00164
      E1=0.0D0                                                          00165
    4 CONTINUE                                                          00166
C  COMPUTE TFP, THE TIME SINCE PERIGEE PASSAGE, AND FAC, PERIOD/2*PI.   00167
      CALL TCONIC(U,CB(3),CB(6),CB(2),TA2,TFP,FAC)                      00168
      N=N                                                               00169
      GO TO (6,5),N                                                     00170
    5 CONTINUE                                                          00171
      T=TFP-CB(19)+TAP*PD                                               00172
      GO TO 12                                                          00173
    6 CONTINUE                                                          00174
      CB(19)=TFP                                                        00175
      N=2                                                               00176
      DO 60 I=1,20                                                      00177
   60 SB(I)=CB(I)                                                       00178
      GO TO 700                                                         00179
    7 CONTINUE                                                          00180
      DO 70 I=1,20                                                      00181
   70 CB(I)=SB(I)                                                       00182
  700 CONTINUE                                                          00183
C  PD=PERIOD                                                            00184
      PD=TPI/CB(8)                                                      00185
      IF(M)8,8,11                                                       00186
    8 CONTINUE                                                          00187
C     TA IS THE INCREMENTAL TRUE ANOMALY                                00188
      CT=DCOS(TA)                                                       00189
      ST=DSIN(TA)                                                       00190
      EF=CT-ST*CB(18)                                                   00191
      GE=ST*CB(4)/CB(12)                                                00192
      R2OR1=CB(11)/(CB(13)+CB(15)*CT-CB(16)*ST)                         00193
      EF=R2OR1*EF                                                       00194
      GE=R2OR1*GE                                                       00195
      EFD=CB(17)*(CB(14)-CB(14)*CT-CB(12)*ST)                           00196
      GED=(CB(15)+CB(13)*CT)/CB(11)                                     00197
      TA2=CB(1)+TA                                                      00198
      TAP=IDINT(TA2/TPI)                                                00199
      TA2=TA2-TPI*TAP                                                   00200
      IF(IDINT(TA2/PI))9,4,10                                           00201
    9 TAP=TAP-1.0D0                                                     00202
      GO TO 4                                                           00203
   10 TAP=TAP+1.0D0                                                     00204
      GO TO 4                                                           00205
   11 CONTINUE                                                          00206
      K=CB(20)                                                          00207
C  CALCULATE THE INCREMENTAL MEAN ANOMALY, EMDT, FOR USE IN GOTOR.      00208
      EMDT=CB(8)*T                                                      00209
      CALL GOTOR(K,EMDT,CB(9),F,E1)                                     00210
      EF=-F(2)/CB(9)+1.0D0                                              00211
      GE=-F(1)/CB(8)+T                                                  00212
      ROA=F(2)+CB(9)*F(4)+CB(10)*F(3)                                   00213
      EFD=-CB(7)*CB(8)*F(3)/(CB(5)*ROA)                                 00214
      GED=-F(2)/ROA+1.0D0                                               00215
      TA=ARKTNS(180,CB(4)*EF+CB(14)*GE,CB(12)*GE)                       00216
      IF(K-1)110,110,12                                                 00217
  110 CONTINUE                                                          00218
      TAP=IDINT(T/PD)                                                   00219
      IF(TA*T)111,112,112                                               00220
  111 TAP=TAP+DSIGN(1.0D0,T)                                            00221
  112 TA=TA+TAP*TPI                                                     00222
   12 CONTINUE                                                          00223
      DO 13 I=1,3                                                       00224
C  COMPUTE THE POSITION AND VELOCITY VECTORS AT TIME T+DT (OR AT MEAN   00225
C  ANOMALY M+DM).                                                       00226
      RR(I)=EF*R(I)+GE*V(I)                                             00227
      VV(I)=EFD*R(I)+GED*V(I)                                           00228
   13 CONTINUE                                                          00229
      RETURN                                                            00230
      END                                                               00231
C          DATA SET TAB1       AT LEVEL 003 AS OF 06/25/79
C          DATA SET TAB1       AT LEVEL 002 AS OF 05/31/79              00001
C          DATA SET TAB1       AT LEVEL 001 AS OF 04/04/78              00002
C                                                                       00003
      SUBROUTINE TAB1(A,S,NOVAR,UBO,FREQ,PCT,STATS,NO,NV)               00004
C                                                                       00005
C                                                                       00006
C  SUBROUTINE TAB1(A,S,NOVAR,UBO,FREQ,PCT,STATS,NO,NV)                  00007
C                                                                       00008
C  THE PURPOSE OF TAB1 IS TO COMPUTE STATISTICAL INFORMATION            00009
C  NEEDED FOR THE FORMATION OF THE HISTOGRAMS                           00010
C                                                                       00011
C  ARGUMENTS IN THE CALLING SEQUENCE ARE DEFINED AS FOLLOWS:            00012
C                                                                       00013
C  ARGUMENT  TYPE  I/O    DEFINITION                                    00014
C                                                                       00015
C     A      R*4    I     SAMPLE DATA                                   00016
C     S      R*4    I     A FLAG: S=1 IN THE CALL STATEMENT IN STATS    00017
C   NOVAR    I*4    I     NUMBER OF VARIABLES                           00018
C    UBO     R*4    I     MAXIMUM AND MINIMUM VALUES FOR A HISTOGRAM    00019
C                         AND THE NUMBER OF INTERVALS                   00020
C    FREQ    R*4    O     FREQUENCY OF OCCURENCES IN AN INTERVAL        00021
C    PCT     R*4    O     PERCENT OF OCCURENCES IN AN INTERVAL OF       00022
C                         THE HISTOGRAM                                 00023
C   STATS    R*4    O     STATS(1)=CUMULATIVE VALUE FOR THE VARIABLE    00024
C                         STATS(2)=MEAN VALUE                           00025
C                         STATS(3)=STANDARD DEVIATION                   00026
C                         STATS(4)=MINIMUM VALUE FOR THE VARIABLE       00027
C                         STATS(5)=MAXIMUM VALUE FOR THE VARIABLE       00028
C     NO     I*4    I     NUMBER OF SAMPLES                             00029
C     NV     I*4    I     NOT USED                                      00030
C                                                                       00031
C  TAB1 IS CALLED BY THE FOLLOWING SUBROUTINE:                          00032
C                                                                       00033
C      STATS                                                            00034
C                                                                       00035
C  NO SUBROUTINE IS CALLED BY TAB1                                      00036
C                                                                       00037
C  TAB1 NEITHER USES NOR ALTERS VARIABLES IN COMMON.  ALL INPUT AND     00038
C  OUTPUT IS THROUGH THE CALLING SEQUENCE.                              00039
C                                                                       00040
C                                                                       00041
      REAL*8 Z(4)                                                       00042
      DIMENSION A(1),UBO(1),FREQ(1),PCT(1),STATS(1)                     00043
      DIMENSION WBO(3)                                                  00044
      DO 5 I = 1,3                                                      00045
    5 WBO(I) = UBO(I)                                                   00046
      VMIN = 1.0E75                                                     00047
      VMAX = -1.0E75                                                    00048
      IJ = NO*(NOVAR-1)                                                 00049
C  COMPUTE THE MAXIMUM AND MINIMUM VALUES IN THE HISTOGRAM              00050
      DO 30 J = 1,NO                                                    00051
      IJ = IJ+1                                                         00052
      IF(S) 10,30,10                                                    00053
   10 IF (A(IJ)-VMIN) 15,20,20                                          00054
   15 VMIN = A(IJ)                                                      00055
   20 IF (A(IJ)-VMAX) 30,30,25                                          00056
   25 VMAX = A(IJ)                                                      00057
   30 CONTINUE                                                          00058
C  STATS(4)=MINIMUM VALUE FOR THE PARAMETER                             00059
      STATS(4) = VMIN                                                   00060
C  STATS(5)=MAXIMUM VALUE FOR THE PARAMETER                             00061
      STATS(5) = VMAX                                                   00062
      IF (UBO(1)-UBO(3)) 40,35,40                                       00063
   35 UBO(1) = VMIN                                                     00064
      UBO(3) = VMAX                                                     00065
   40 INN = UBO(2)                                                      00066
      DO 45 I = 1,INN                                                   00067
      FREQ(I) = 0.0                                                     00068
   45 PCT(I) = 0.0                                                      00069
      DO 50 I = 1,3                                                     00070
      Z(I) = 0.D0                                                       00071
   50 STATS(I) = 0.0                                                    00072
      SINT = ABS((UBO(3)-UBO(1))/(UBO(2)-2.0))                          00073
      SCNT = 0.0                                                        00074
      IJ = NO*(NOVAR-1)                                                 00075
      DO 75 J = 1,NO                                                    00076
      IJ = IJ+1                                                         00077
      IF(S) 55,75,55                                                    00078
   55 SCNT = SCNT+1.0                                                   00079
      STATS(1) = STATS(1)+A(IJ)                                         00080
      STATS(3) = STATS(3)+A(IJ)*A(IJ)                                   00081
      Z(4) = A(IJ)                                                      00082
C  Z(1) IS THE CUMULATIVE VALUE FOR THE VARIABLE                        00083
      Z(1) = Z(1)+Z(4)                                                  00084
      Z(3) = Z(3)+Z(4)**2                                               00085
      TEMP = UBO(1)-SINT                                                00086
      INTX = INN-1                                                      00087
      DO 60 I = 1,INTX                                                  00088
      TEMP = TEMP+SINT                                                  00089
      IF (A(IJ)-TEMP) 70,60,60                                          00090
   60 CONTINUE                                                          00091
      IF (A(IJ)-TEMP) 75,65,65                                          00092
   65 FREQ(INN) = FREQ(INN)+1.0                                         00093
      GO TO 75                                                          00094
   70 FREQ(I) = FREQ(I)+1.0                                             00095
   75 CONTINUE                                                          00096
      STATS(1) = Z(1)                                                   00097
      STATS(3) = Z(3)                                                   00098
C  COMPUTE PERCENT OF OCCURENCE FOR EACH HISTOGRAM INTERVAL             00099
      DO 80 I = 1,INN                                                   00100
   80 PCT(I) = FREQ(I)*100.0/SCNT                                       00101
      IF (SCNT-1.0) 85,85,90                                            00102
   85 STATS(2) = 0.0                                                    00103
      STATS(3) = 0.0                                                    00104
      GO TO 95                                                          00105
C  COMPUTE THE MEAN VALUE                                               00106
   90 STATS(2) = STATS(1)/SCNT                                          00107
      Z(2) = SCNT                                                       00108
C  COMPUTE THE STANDARD DEVIATION                                       00109
      Z(4) =DSQRT(DABS((Z(3)-Z(1)**2/Z(2))/(Z(2)-1.D0)))                00110
      STATS(3) = Z(4)                                                   00111
   95 DO 100 I = 1,3                                                    00112
  100 UBO(I) = WBO(I)                                                   00113
      RETURN                                                            00114
      END                                                               00115
C          DATA SET TCONIC     AT LEVEL 004 AS OF 06/19/79
C          DATA SET TCONIC     AT LEVEL 003 AS OF 05/18/79              00001
C          DATA SET TCONIC     AT LEVEL 001 AS OF 04/04/78              00002
C                                                                       00003
      SUBROUTINE TCONIC(U,EC,A,SLR,TA2,T,FAC)                           00004
C                                                                       00005
C  SUBROUTINE TCONIC(U,EC,A,SLR,TA2,T,FAC)                              00006
C                                                                       00007
C  THE PURPOSE OF TCONIC IS TO FIND THE TIME SINCE                      00008
C  PERIGEE PASSAGE.                                                     00009
C                                                                       00010
C  THE ARGUMENTS IN THE CALLING SEQUENCE ARE DEFINED AS FOLLOWS:        00011
C                                                                       00012
C  ARGUMENT     TYPE     I/O     DEFINITION                             00013
C                                                                       00014
C     U         R*8       I    GRAVITATIONAL CONSTANT FOR THE EARTH     00015
C     EC        R*8       I    INPUT ECCENTRICITY                       00016
C     A         R*8       I    SEMI-MAJOR AXIS                          00017
C     SLR       R*8       I    SEMI LATUS RECTUM                        00018
C     TA2       R*8       I    TRUE ANOMALY                             00019
C     T         R*8       O    TIME SINCE PERIGEE PASSAGE               00020
C     FAC       R*8       O    PERIOD OF THE ORBIT/(2*PI)               00021
C                                                                       00022
C  TCONIC IS CALLED BY THE FOLLOWING SUBROUTINES:                       00023
C                                                                       00024
C      CONBR     ORB     STEPD                                          00025
C                                                                       00026
C  NO SUBROUTINES ARE CALLED BY TCONIC                                  00027
C                                                                       00028
C  THE VARIABLE APPEARING IN A COMMON BLOCK IS GIVEN BELOW:             00029
C                                                                       00030
C COMMON VARIABLE USED:  XPI                                            00031
C                                                                       00032
C                                                                       00033
      IMPLICIT REAL*8(A-H,O-Z)                                          00034
      COMMON /CONST/ S2LB,D2R,XPI,R2D,F2KM,XKM2F,G0                     00035
      TANG(Q000FL)=DSIN(Q000FL)/DCOS(Q000FL)                            00036
      AB=DABS(A)                                                        00037
C  FAC=PERIOD/2*PI                                                      00038
      FAC=AB*DSQRT(AB/U)                                                00039
C  CALCULATE ECA, THE ECCENTRIC ANOMALY                                 00040
      ECA=(1.0D0-EC)/(1.0D0+EC)                                         00041
      ABE=DSQRT(DABS(ECA))                                              00042
      THE=TANG(.5D0*TA2)                                                00043
      IF(ABE-.00005D0)11,11,12                                          00044
   12 CONTINUE                                                          00045
      ECA=2.0D0*DATAN(ABE*THE)                                          00046
      IF(A)14,11,13                                                     00047
C  IF ORBIT IS ELLIPTICAL, SOLVE KEPLER'S EQUATION FOR THE              00048
C  TIME SINCE PERIGEE PASSAGE                                           00049
   13 T=FAC*(ECA-EC*DSIN(ECA))                                          00050
      GO TO 16                                                          00051
C  SOLVING FOR THE TIME SINCE PERIGEE PASSAGE, IF THE ORBIT IS          00052
C  HYPERBOLIC                                                           00053
   14 ANG=XPI/4.+.5D0*ECA                                               00054
      T=FAC*(EC*TANG(ECA)-DLOG(TANG(ANG)))                              00055
      GO TO 16                                                          00056
C  SOLVING FOR THE TIME SINCE PERIGEE PASSAGE, IF THE ORBIT IS          00057
C  NEARLY PARABOLIC                                                     00058
   11 FAC=DSQRT(SLR**3/U)*2.0D0/((1.0D0+EC)**2)                         00059
      EC1=ECA*THE**2                                                    00060
      T=FAC*(THE+THE**3*((1.0D0-2.0D0*ECA)/3.0D0-(2.0D0-3.0D0*ECA)*EC1/500061
     1.0D0+(3.0D0-4.0D0*ECA)*EC1**2/7.0D0-(4.0D0-5.0D0*ECA)*EC1**3/9.0D000062
     *))                                                                00063
   16 CONTINUE                                                          00064
      RETURN                                                            00065
      END                                                               00066
C          DATA SET TFY        AT LEVEL 003 AS OF 06/25/79
C          DATA SET TFY        AT LEVEL 002 AS OF 06/01/79              00001
      SUBROUTINE TFY (TR,TV,T50)                                        00002
C                                                                       00003
C                                                                       00004
C     SUBROUTINE TFY (TR,TV,T50)                                        00005
C                                                                       00006
C                                                                       00007
C                                                                       00008
C     THE PURPOSE OF TFY IS TO FORM THREE MUTUALLY  PERPENDICULAR       00009
C         UNIT VECTORS.                                                 00010
C                                                                       00011
C                                                                       00012
C                                                                       00013
C     ARGUMENTS IN THE CALLING SEQUENCE ARE DEFINED AS FOLLOWS.         00014
C                                                                       00015
C         ARGUMENT   TYPE    I/O        DEFINITION                      00016
C                                                                       00017
C          TR(3)     R*8      I      VECTOR USED TO CONSTRUCT           00018
C                                        A COORDINATE SYSTEM            00019
C          TV(3)     R*8      I      VECTOR WHICH BECOMES THE X-AXIS    00020
C                                        OF THE NEW COORDINATE SYSTEM   00021
C          T50(6,3)  R*8      O      T50(I,1)-STORES THE X-AXIS         00022
C                                             UNIT VECTOR               00023
C                                    T50(I,2)-STORES THE Y-AXIS         00024
C                                             UNIT VECTOR               00025
C                                    T50(I,3)-STORES THE Z-AXIS         00026
C                                             UNIT VECTOR               00027
C                                                                       00028
C                                                                       00029
C                                                                       00030
C     TFY IS CALLED BY THE FOLLOWING SUBROUTINES.                       00031
C                                                                       00032
C         CVPROP    RANTAR                                              00033
C                                                                       00034
C                                                                       00035
C     THE FOLLOWING SUBROUTINE IS CALLED BY TFY.                        00036
C                                                                       00037
C         CROSS                                                         00038
C                                                                       00039
C                                                                       00040
C                                                                       00041
C     THE FOLLOWING FUNCTION SUBPROGRAM IS CALLED BY TFY.               00042
C                                                                       00043
C         FNORM                                                         00044
C                                                                       00045
C                                                                       00046
C                                                                       00047
C     TFY NEITHER USES NOR ALTERS VARIABLES IN COMMON. ALL              00048
C         INPUT AND OUTPUT IS THROUGH THE CALLING SEQUENCE.             00049
C                                                                       00050
C                                                                       00051
C                                                                       00052
      IMPLICIT REAL*8(A-H,O-Z)                                          00053
      DIMENSION T50(6,3),TR(3),TV(3),Y(3),Z(3)                          00054
      VM = FNORM(TV)                                                    00055
      CALL CROSS (TR,TV,Z)                                              00056
      CALL CROSS (Z, TV, Y)                                             00057
      YM = FNORM(Y)                                                     00058
      ZM = FNORM(Z)                                                     00059
C  COMPUTE THE X, Y, AND Z UNIT VECTORS WHICH DEFINE THE NEW            00060
C  COORDINATE SYSTEM                                                    00061
      DO 1 I=1,3                                                        00062
      T50(I,1) = TV(I)/VM                                               00063
      T50(I,2)=Y(I) /YM                                                 00064
      T50(I,3) = Z(I) /ZM                                               00065
1     CONTINUE                                                          00066
      RETURN                                                            00067
      END                                                               00068
C          DATA SET TOLER      AT LEVEL 002 AS OF 05/18/79
C          DATA SET TOLER      AT LEVEL 001 AS OF 04/04/78              00001
      SUBROUTINE TOLER(N,P,KP,XTOL,X,ALPHA,XINF,XSUP)                   00002
C                                                                       00003
C                                                                       00004
C  SUBROUTINE TOLER(N,P,KP,XTOL,X,ALPHA,XINF,XSUP)                      00005
C                                                                       00006
C     THIS SECTION DOES THE FOLLOWING:                                  00007
C                                                                       00008
C     GIVEN:A P-VALUE, P; A QUANTILE OF ORDER P, KP; A SAMPLE SIZE, N;  00009
C     ORDER STATISTICS,X((I)); A TOLERANCE, TOL;                        00010
C     FIND:THE CONFIDENCE COEFFICIENT, ALPHA, ASSOCIATED WITH THE INTER-00011
C     VAL(X(R), X(S)), WHERE X(R) IS THE LARGEST ORDER STATISTIC LESS   00012
C     THAN  KP - TOL, AND X(S) IS THE LEAST ORDER STATISTIC GREATER THAN00013
C     KP + TOL.                                                         00014
C                                                                       00015
C  ARGUMENTS IN THE CALLING SEQUENCE ARE DEFINED AS FOLLOWS:            00016
C                                                                       00017
C  ARGUMENT  TYPE  I/O    DEFINITION                                    00018
C                                                                       00019
C     N      I*4    I    NUMBER OF SAMPLES                              00020
C     P      R*8    I    PERCENTILE                                     00021
C     KP     R*8    I    PERCENTILE VALUE WITH RESPECT TO THE NOMINAL   00022
C     XTOL   R*8    I    A TOLERANCE                                    00023
C     X      R*4    I    SAMPLE DATA READ FROM LU20 IN SUBPROGRAM STATS 00024
C     ALPHA  R*8    O    CONFIDENCE COEFFICIENT                         00025
C     XINF   R*8    O    LARGEST ORDER STATISTIC LESS THAN KP-TOL       00026
C     XSUP   R*8    O    LOWEST ORDER STATISTIC GREATER THAN KP+TOL     00027
C                                                                       00028
C  TOLER IS CALLED BY THE FOLLOWING SUBROUTINE:                         00029
C                                                                       00030
C    STATS                                                              00031
C                                                                       00032
C  NO SUBPROGRAM IS CALLED BY TOLER                                     00033
C                                                                       00034
C  THE VARIABLE APPEARING IN A COMMON BLOCK IS GIVEN BELOW:             00035
C                                                                       00036
C    COMMON VARIABLE USED: XPI                                          00037
C                                                                       00038
C                                                                       00039
      IMPLICIT REAL*8(A-H,O-Z)                                          00040
      REAL*8 KP                                                         00041
      REAL*4 X                                                          00042
      COMMON /CONST/S2LB,D2R,XPI,R2D,F2KM,XKM2F,G0                      00043
      INTEGER R,S                                                       00044
      DIMENSION X(1)                                                    00045
C                                                                       00046
      P=P/100.D0                                                        00047
      TOL=XTOL                                                          00048
      LTOL=0                                                            00049
      HTOL=0                                                            00050
  250 CONTINUE                                                          00051
C                                                                       00052
C     I. FIND X(R):                                                     00053
C                                                                       00054
      TEST1 = KP - TOL                                                  00055
      DO 700 I = 1, N                                                   00056
      IF(X(I).GT.TEST1) GO TO 750                                       00057
  700 CONTINUE                                                          00058
  750 CONTINUE                                                          00059
      R = I - 1                                                         00060
C                                                                       00061
C     II. FIND X(S):                                                    00062
C                                                                       00063
      TEST2 = KP + TOL                                                  00064
      DO 790 J = 1, N                                                   00065
      K = N - (J - 1)                                                   00066
      IF(X(K).LT.TEST2) GO TO 795                                       00067
  790 CONTINUE                                                          00068
  795 CONTINUE                                                          00069
      S = K + 1                                                         00070
      IF(R.GE.0) GO TO 797                                              00071
      TOLNEW = KP - X(1)                                                00072
      LTOL=1                                                            00073
      GO TO 798                                                         00074
  797 IF(S.LE.N) GO TO 796                                              00075
      TOLNEW = X(N) - KP                                                00076
      HTOL=1                                                            00077
  798 TOL=TOLNEW                                                        00078
      GO TO 250                                                         00079
  796 CONTINUE                                                          00080
C                                                                       00081
C     III. FIND CONFIDENCE COEFFICIENTS:                                00082
C                                                                       00083
      ACCUM = 0.D0                                                      00084
      IS = S - 1                                                        00085
      DO 800 I = R, IS                                                  00086
      ACCUM=ACCUM + 1.D0 / (DSQRT(2.D0*XPI)*DSQRT(FLOAT(N)*P*           00087
     1 (1.D0 - P))) * DEXP(-1.D0 * (FLOAT(I) - FLOAT(N) * P) ** 2 /     00088
     2 (2.D0 * FLOAT(N) * P * (1.D0 - P)))                              00089
  800 CONTINUE                                                          00090
      ALPHA=ACCUM                                                       00091
      XINF = X(R)                                                       00092
      XSUP = X(S)                                                       00093
  999 CONTINUE                                                          00094
      P=P*100.D0                                                        00095
      WRITE(6,1)   P,KP,ALPHA,XINF,XSUP                                 00096
    1 FORMAT(1H0,14X,F9.2,5X,F15.7,3X,F6.2,4X,F15.7,3X,F15.7)           00097
      IF(LTOL.EQ.1) WRITE(6,2)                                          00098
    2 FORMAT(1H ,59X,'(1ST SAMP)')                                      00099
      IF(HTOL.EQ.1) WRITE(6,3)                                          00100
    3 FORMAT(1H ,80X,'(NTH SAMP)')                                      00101
C                                                                       00102
      RETURN                                                            00103
      END                                                               00104
C          DATA SET TWOBDY     AT LEVEL 001 AS OF 04/04/78
C                                                                       00000010
      SUBROUTINE TWOBDY(S0,TAU,MU,PSI,S,P,PI,PMU,P0MU,ACC,ACC0,R,R0)    00000020
C                                                                       00000030
C                                                                       00000040
C     SUBROUTINE TWOBDY (SO,TAU,MU,PSI,S,P,PI,PMU,P0MU,ACC,ACC0,R,R0)   00000050
C                                                                       00000060
C                                                                       00000070
C                                                                       00000080
C     THE PURPOSE OF TWOBDY IS TO SOLVE THE GENERAL TWO                 00000090
C         BODY PROBLEM USING PARTIAL DERIVATIVES.                       00000100
C                                                                       00000110
C                                                                       00000120
C                                                                       00000130
C     ARGUMENTS IN THE CALLING SEQUENCE ARE DEFINED AS FOLLOWS.         00000140
C                                                                       00000150
C         ARGUMENT   TYPE    I/O        DEFINITION                      00000160
C                                                                       00000170
C          SO(6)     R*8      I      STATE VECTOR AT REFERENCE TIME     00000180
C                                        (CARTESIAN COORDINATES)        00000190
C          TAU       R*8      I      TIME INTERVAL FROM REFERENCE       00000200
C                                        TIME TO SOLUTION TIME          00000210
C          MU        R*8      I      GRAVITATIONAL CONSTANT FACTOR      00000220
C          PSI       R*8     I/O     ON INPUT, PSI IS A GUESS OF THE    00000230
C                                              ECCENTRIC ANOMALY SOLUTIO00000240
C                                    ON OUTPUT,PSI IS THE ECCENTRIC     00000250
C                                              ANOMALY AT SOLUTION TIME 00000260
C          S(6)      R*8      O      STATE VECTOR AT SOLUTION TIME      00000270
C                                        (CARTESIAN COORDINATES)        00000280
C          P(6,6)    R*8      O      PARTIAL DERIVATIVE OF S(I) WITH    00000290
C                                        RESPECT TO S(J), WITH ROLES OF 00000300
C                                        REFERENCE TIME AND SOLUTION    00000310
C                                        TIME REVERSED                  00000320
C          PMU(6)    R*8      O      PARTIAL OF S(I) WITH RESPECT TO MU 00000330
C          P0MU(6)   R*8      O      PARTIAL OF S0(1) WITH RESPECT TO   00000340
C                                        MU, WITH REFERENCE TIME AND    00000350
C                                        SOLUTION TIME REVERSED         00000360
C          ACC(3)    R*8      O      ACCELERATION VECTOR AT             00000370
C                                        SOLUTION TIME                  00000380
C          ACC0(3)   R*8      O      ACCELERATION VECTOR AT             00000390
C                                        REFERENCE TIME                 00000400
C          R         R*8      O      RADIUS MAGNITUDE AT                00000410
C                                        SOLUTION TIME                  00000420
C          R0        R*8      O      RADIUS MAGNITUDE AT                00000430
C                                        REFERENCE TIME                 00000440
C                                                                       00000450
C                                                                       00000460
C     TWOBDY IS CALLED BY THE FOLLOWING SUBROUTINES.                    00000470
C                                                                       00000480
C         CVPROP                                                        00000490
C                                                                       00000500
C                                                                       00000510
C                                                                       00000520
C     NO SUBROUTINES ARE CALLED BY TWOBDY.                              00000530
C                                                                       00000540
C                                                                       00000550
C                                                                       00000560
C     TWOBDY NEITHER USES NOR ALTERS VARIABLES IN COMMON. ALL           00000570
C         INPUT AND OUTPUT IS THROUGH THE CALLING SEQUENCE.             00000580
C                                                                       00000590
C                                                                       00000600
C                                                                       00000610
C                                                                       00000620
C                                                                       00000630
C GENERAL SOLUTION OF TWO BODY PROBLEM WITH PARTIAL DERIVATIVES         00000640
C FORTRAN 4 DOUBLE PRECISION SUBROUTINE FOR IBM 7094 WITH IBSYS SYSTEM  00000650
C SEE APRIL 1965 ASTRONOMICAL JOURNAL FOR FORMULATION BY W. H. GOODYEAR 00000660
C                                                                       00000670
C CALLING SEQUENCE IS AS FOLLOWS                                        00000680
C     CALL TWOBDY(S0,TAU,MU,PSI,S,P,PI,PMU,P0MU,ACC,ACC0,R,R0)          00000690
C                                                                       00000700
C DOUBLE PRECISION QUANTITIES IN CALLING SEQUENCE ARE AS FOLLOWS        00000710
      IMPLICIT REAL*8(A-H,O-Z)                                          00000720
      DOUBLE PRECISION S0(6),TAU,MU,PSI                                 00000730
     1,S(6),P(6,6),PI(6,6),PMU(6),P0MU(6),ACC(3),ACC0(3),R,R0           00000740
C                                                                       00000750
C             INPUTS                                                    00000760
C S0(1),S0(2),S0(3)=X0,Y0,Z0=POSITION COMPONENTS AT REFERENCE TIME T0   00000770
C S0(4),S0(5),S0(6)=XD0,YD0,ZD0=VELOCITY COMPONENTS AT REFERENCE TIME T000000780
C TAU=TIME INTERVAL (T-T0) FROM REFERENCE TIME T0 TO SOLUTION TIME T    00000790
C MU=CONSTANT IN DIFFERENTIAL EQUATIONS (XDD,YDD,ZDD)=-MU*(X,Y,Z)/(R**3)00000800
C PSI=APPROXIMATION FOR FINAL SOLUTION PSI OF KEPLER'S EQUATION         00000810
C                                                                       00000820
C             OUTPUTS                                                   00000830
C PSI=GENERALIZED ECCENTRIC ANOMALY=SOLUTION OF KEPLERS EQUATION        00000840
C S(1),S(2),S(3)=X,Y,Z=POSITION COMPONENTS AT SOLUTION TIME T=T0+TAU    00000850
C S(4),S(5),S(6)=XD,YD,ZD=VELOCITY COMPONENTS AT SOLUTION TIME T=T0+TAU 00000860
C P(I,J)=PARTIAL DERIVATIVE DS(I)/DS0(J) OF S(I) WITH RESPECT TO S0(J)  00000870
C PI(I,J)=PARTIAL DS0(I)/DS(J) WITH ROLES OF T0 AND T REVERSED          00000880
C PMU(I)=PARTIAL DS(I)/DMU OF S(I) WITH RESPECT TO MU                   00000890
C P0MU(I)=PARTIAL DS0(I)/DMU WITH ROLES OF T0 AND T REVERSED            00000900
C ACC(I)=-MU*S(I)/(R**3)=ACCELERATION COMPONENT AT SOLUTION TIME T      00000910
C ACC0(I)=-MU*S0(I)/(R0**3)=ACCELERATION COMPONENT AT REFERENCE TIME T0 00000920
C R=RADIUS AT TIME T=SQUARE ROOT OF(X**2+Y**2+Z**2)                     00000930
C R0=RADIUS AT TIME T0=SQUARE ROOT OF(X0**2+Y0**2+Z0**2)                00000940
C                                                                       00000950
C ADDITIONAL DOUBLE PRECISION QUANTITIES FOR COMPUTATION                00000960
     2,SIG0,ALPHA,PSIN,PSIP,A,AP,C0,C1,C2,C3,C4,C5X3,S1,S2,S3,DTAU,DTAUN00000970
     3,DTAUP,U,FM1,G,FD,GDM1                                            00000980
C                                                                       00000990
C START OF INITIAL COMPUTATIONS                                         00001000
C COMPUTE RADIUS R0=SQUARE ROOT OF(X0**2+Y0**2+Z0**2)                   00001010
      S1=DMAX1(DABS(S0(1)),DABS(S0(2)),DABS(S0(3)))                     00001020
      S2=(S0(1)/S1)**2+(S0(2)/S1)**2+(S0(3)/S1)**2                      00001030
      R0=2.D0                                                           00001040
   10 R=R0                                                              00001050
      R0=(R+S2/R)*.5D0                                                  00001060
      IF(R0.LT.R) GO TO 10                                              00001070
      R0=R0*S1                                                          00001080
C COMPUTE OTHER PARAMETERS                                              00001090
      SIG0=S0(1)*S0(4)+S0(2)*S0(5)+S0(3)*S0(6)                          00001100
      ALPHA=S0(4)**2+S0(5)**2+S0(6)**2-2.D0*MU/R0                       00001110
C INITIALIZE SERIES MOD COUNT M TO ZERO                                 00001120
      M=0                                                               00001130
C INITIALIZE BOUNDS PSIN AND PSIP FOR PSI OR SET PSI=0 IF TAU=0         00001140
      IF(TAU) 20,30,40                                                  00001150
   20 PSIN=-1.D+38                                                      00001160
      PSIP=0.D0                                                         00001170
      DTAUN=PSIN                                                        00001180
      DTAUP=-TAU                                                        00001190
      GO TO 50                                                          00001200
   30 PSI=0.D0                                                          00001210
      GO TO 100                                                         00001220
   40 PSIN=0.D0                                                         00001230
      PSIP=+1.D+38                                                      00001240
      DTAUN=-TAU                                                        00001250
      DTAUP=PSIP                                                        00001260
C USE APPROXIMATION FOR PSI IF IT IS BETWEEN BOUNDS PSIN AND PSIP       00001270
   50 IF(PSI.GT.PSIN.AND.PSI.LT.PSIP) GO TO 100                         00001280
C TRY NEWTON'S METHOD FOR INITIAL PSI SET EQUAL TO ZERO                 00001290
      PSI=TAU/R0                                                        00001300
C SET PSI=TAU IF NEWTON'S METHOD FAILS                                  00001310
      IF(PSI.LE.PSIN.OR.PSI.GE.PSIP) PSI=TAU                            00001320
C END OF INITIAL COMPUTATIONS                                           00001330
C                                                                       00001340
C BEGINNING OF LOOP FOR SOLVING KEPLER'S EQUATION                       00001350
C BEGINNING OF SERIES SUMMATION                                         00001360
C COMPUTE ARGUMENT A IN REDUCED SERIES OBTAINED BY FACTORING OUT PSI'S  00001370
  100 A=ALPHA*PSI*PSI                                                   00001380
      IF(DABS(A).LE.1.D0) GO TO 120                                     00001390
C SAVE A IN AP AND MOD A IF IT EXCEEDS UNITY IN MAGNITUDE               00001400
      AP=A                                                              00001410
  110 M=M+1                                                             00001420
      A=A*.25D0                                                         00001430
      IF(DABS(A).GT.1.D0) GO TO 110                                     00001440
C SUM SERIES C5X3=3*S5/PSI**5 AND C4=S4/PSI**4                          00001450
  120 C5X3=(1.D0+(1.D0+(1.D0+(1.D0+(1.D0+(1.D0+(1.D0+A/342.D0)*A/272.D0)00001460
     1*A/210.D0)*A/156.D0)       *A/110.D0)*A/72.D0)*A/42.D0)/40.D0     00001470
      C4  =(1.D0+(1.D0+(1.D0+(1.D0+(1.D0+(1.D0+(1.D0+A/306.D0)*A/240.D0)00001480
     1*A/182.D0)*A/132.D0)       *A/90.D0)*A/56.D0)*A/30.D0)/24.D0      00001490
C COMPUTE SERIES C3=S3/PSI**3,C2=S2/PSI**2,C1=S1/PSI,C0=S0              00001500
      C3=(.5D0+A*C5X3)/3.D0                                             00001510
      C2= .5D0+A*C4                                                     00001520
      C1= 1.D0+A*C3                                                     00001530
      C0= 1.D0+A*C2                                                     00001540
      IF(M.LE.0) GO TO 140                                              00001550
C DEMOD SERIES C0 AND C1 IF NECESSARY WITH DOUBLE ANGLE FORMULAS        00001560
  130 C1=C1*C0                                                          00001570
      C0=2.D0*C0*C0-1.D0                                                00001580
      M=M-1                                                             00001590
      IF(M.GT.0) GO TO 130                                              00001600
C DETERMINE C2,C3,C4,C5X3 FROM C0,C1,AP IF DEMOD REQUIRED               00001610
      C2=(C0-1.D0)/AP                                                   00001620
      C3=(C1-1.D0)/AP                                                   00001630
      C4=(C2-.5D0)/AP                                                   00001640
      C5X3=(3.D0*C3-.5D0)/AP                                            00001650
C COMPUTE SERIES S1,S2,S3 FROM C1,C2,C3                                 00001660
  140 S1=C1*PSI                                                         00001670
      S2=C2*PSI*PSI                                                     00001680
      S3=C3*PSI*PSI*PSI                                                 00001690
C END OF SERIES SUMMATION                                               00001700
C COMPUTE RESIDUAL DTAU AND SLOPE R FOR KEPLER'S EQUATION               00001710
      G=R0*S1+SIG0*S2                                                   00001720
      DTAU=(G+MU*S3)-TAU                                                00001730
      R=DABS(R0*C0+(SIG0*S1+MU*S2))                                     00001740
      IF(DTAU) 200,300,210                                              00001750
C RESET BOUND                                                           00001760
  200 PSIN=PSI                                                          00001770
      DTAUN=DTAU                                                        00001780
      GO TO 220                                                         00001790
  210 PSIP=PSI                                                          00001800
      DTAUP=DTAU                                                        00001810
C TRY NEWTON'S METHOD AND INITIALIZE SELECTOR N                         00001820
  220 PSI=PSI-DTAU/R                                                    00001830
      N=0                                                               00001840
C ACCEPT PSI IF IT IS BETWEEN BOUNDS PSIN AND PSIP                      00001850
  230 IF(PSI.GT.PSIN.AND.PSI.LT.PSIP) GO TO 100                         00001860
C SELECT ALTERNATE METHOD OF COMPUTING PSI OR STOP ITERATIONS           00001870
      N=N+1                                                             00001880
      GO TO (1,2,3,4,300),N                                             00001890
C TRY INCREMENTING BOUND WITH DTAU NEAREST ZERO BY THE RATIO 4*DTAU/TAU 00001900
    1 IF(DABS(DTAUN).LT.DABS(DTAUP)) PSI=PSIN*(1.D0-(4.D0*DTAUN)/TAU)   00001910
      IF(DABS(DTAUP).LT.DABS(DTAUN)) PSI=PSIP*(1.D0-(4.D0*DTAUP)/TAU)   00001920
      GO TO 230                                                         00001930
C TRY DOUBLING BOUND CLOSEST TO ZERO                                    00001940
    2 IF(TAU.GT.0.D0) PSI=PSIN+PSIN                                     00001950
      IF(TAU.LT.0.D0) PSI=PSIP+PSIP                                     00001960
      GO TO 230                                                         00001970
C TRY INTERPOLATION BETWEEN BOUNDS                                      00001980
    3 PSI=PSIN+(PSIP-PSIN)*(-DTAUN/(DTAUP-DTAUN))                       00001990
      GO TO 230                                                         00002000
C TRY HALVING BETWEEN BOUNDS                                            00002010
    4 PSI=PSIN+(PSIP-PSIN)*.5D0                                         00002020
      GO TO 230                                                         00002030
C END OF LOOP FOR SOLVING KEPLER'S EQUATION                             00002040
C                                                                       00002050
C COMPUTE REMAINING THREE OF FOUR FUNCTIONS FM1,G,FD,GDM1               00002060
  300 FM1=-MU*S2/R0                                                     00002070
      FD=-MU*S1/R0/R                                                    00002080
      GDM1=-MU*S2/R                                                     00002090
C COMPUTE COORDINATES AT SOLUTION TIME T=T0+TAU                         00002100
      DO 310 I=1,3                                                      00002110
      S(I)=S0(I)+(FM1*S0(I)+G*S0(I+3))                                  00002120
      S(I+3)=(FD*S0(I)+GDM1*S0(I+3))+S0(I+3)                            00002130
C COMPUTE ACCELERATIONS                                                 00002140
      ACC(I)=-MU*S(I)/R/R/R                                             00002150
  310 ACC0(I)=-MU*S0(I)/R0/R0/R0                                        00002160
C END OF COMPUTATION FOR COORDINATES AND ACCELERATIONS                  00002170
C                                                                       00002180
C COMPUTATION OF PARTIAL DERIVATIVES                                    00002190
C COMPUTE COEFFICIENTS FOR STATE PARTIALS                               00002200
      U= S2*TAU+MU*(C4-C5X3)*PSI*PSI*PSI*PSI*PSI                        00002210
      P(1,1)=-(FD*S1+FM1/R0)/R0                                         00002220
      P(1,2)=-FD*S2                                                     00002230
      P(2,1)= FM1*S1/R0                                                 00002240
      P(2,2)= FM1*S2                                                    00002250
      P(1,3)= P(1,2)                                                    00002260
      P(1,4)=-GDM1*S2                                                   00002270
      P(2,3)= P(2,2)                                                    00002280
      P(2,4)= G*S2                                                      00002290
      P(3,1)=-FD*(C0/R0/R+1.D0/R/R+1.D0/R0/R0)                          00002300
      P(3,2)=-(FD*S1+GDM1/R)/R                                          00002310
      P(4,1)=-P(1,1)                                                    00002320
      P(4,2)=-P(1,2)                                                    00002330
      P(3,3)= P(3,2)                                                    00002340
      P(3,4)=-GDM1*S1/R                                                 00002350
      P(4,3)=-P(1,2)                                                    00002360
      P(4,4)=-P(1,4)                                                    00002370
C COMPUTE COEFFICIENTS FOR MU PARTIALS                                  00002380
      P(1,5)=-S1/R0/R                                                   00002390
      P(2,5)= S2/R0                                                     00002400
      P(3,5)= U/R0-S3                                                   00002410
      P(1,6)=-P(1,5)                                                    00002420
      P(2,6)= S2/R                                                      00002430
      P(3,6)=-U/R+S3                                                    00002440
      DO 400 I=1,3                                                      00002450
C COMPUTE MU PARTIALS                                                   00002460
      PMU(I)=-S(I)*P(2,5)+S(I+3)*P(3,5)                                 00002470
      PMU(I+3)= S(I)*P(1,5)+S(I+3)*P(2,5)+ACC(I)*P(3,5)                 00002480
      P0MU(I)=-S0(I)*P(2,6)+S0(I+3)*P(3,6)                              00002490
      P0MU(I+3)= S0(I)*P(1,6)+S0(I+3)*P(2,6)+ACC0(I)*P(3,6)             00002500
C MATRIX ACCUMULATIONS FOR STATE PARTIALS                               00002510
      DO 400 J=1,4                                                      00002520
      PI(J,I)= P(J,1)*S0(I)+P(J,2)*S0(I+3)                              00002530
  400 PI(J,I+3)= P(J,3)*S0(I)+P(J,4)*S0(I+3)                            00002540
      DO 410 I=1,3                                                      00002550
      DO 420 J=1,3                                                      00002560
      P(I,J)    =S(I)*PI(1,J)  +S(I+3)*PI(2,J)  +U*S(I+3)*ACC0(J)       00002570
      P(I,J+3)  =S(I)*PI(1,J+3)+S(I+3)*PI(2,J+3)-U*S(I+3)*S0(J+3)       00002580
      P(I+3,J)  =S(I)*PI(3,J)  +S(I+3)*PI(4,J)  +U*ACC(I)*ACC0(J)       00002590
  420 P(I+3,J+3)=S(I)*PI(3,J+3)+S(I+3)*PI(4,J+3)-U*ACC(I)*S0(J+3)       00002600
      P(I,I)    =P(I,I)    +FM1+1.D0                                    00002610
      P(I,I+3)  =P(I,I+3)  +G                                           00002620
      P(I+3,I)  =P(I+3,I)  +FD                                          00002630
  410 P(I+3,I+3)=P(I+3,I+3)+GDM1+1.D0                                   00002640
C TRANSPOSITIONS FOR INVERSE STATE PARTIALS                             00002650
      DO 430 I=1,3                                                      00002660
      DO 430 J=1,3                                                      00002670
      PI(J+3,I+3)= P(I,J)                                               00002680
      PI(J+3,I)  =-P(I+3,J)                                             00002690
      PI(J,I+3)  =-P(I,J+3)                                             00002700
  430 PI(J,I)    = P(I+3,J+3)                                           00002710
C END OF COMPUTATION FOR PARTIAL DERIVATIVES                            00002720
C                                                                       00002730
C END OF PROGRAM - ALL OUTPUTS HAVE BEEN COMPUTED                       00002740
      RETURN                                                            00002750
      END                                                               00002760
C          DATA SET UCROSS     AT LEVEL 005 AS OF 06/19/79              00000000
C          DATA SET UCROSS     AT LEVEL 004 AS OF 05/10/79              00000010
      SUBROUTINE UCROSS(A,B,C)                                          00000020
C                                                                       00000030
C                                                                       00000040
C     SUBROUTINE UCROSS (A,B,C)                                         00000050
C                                                                       00000060
C                                                                       00000070
C                                                                       00000080
C     THE PURPOSE OF UCROSS IS TO PERFORM THE CROSS PRODUCT OF TWO      00000090
C         VECTORS AND UNITIZE THE RESULTANT VECTOR.                     00000100
C                                                                       00000110
C                                                                       00000120
C                                                                       00000130
C     ARGUMENTS IN THE CALLING SEQUENCE ARE DEFINED AS FOLLOWS.         00000140
C                                                                       00000150
C         ARGUMENT   TYPE    I/O        DEFINITION                      00000160
C                                                                       00000170
C          A(3)      R*8      I      INPUT VECTOR                       00000180
C          B(3)      R*8      I      INPUT VECTOR                       00000190
C          C(3)      R*8      O      UNIT VECTOR OF RESULTANT CROSS     00000200
C                                       PRODUCT                         00000210
C                                                                       00000220
C                                                                       00000230
C     UCROSS IS CALLED BY THE FOLLOWING SUBROUTINES.                    00000240
C                                                                       00000250
C         DELVS     MINDVH    PREP                                      00000260
C                                                                       00000270
C                                                                       00000280
C                                                                       00000290
C                                                                       00000300
C     NO SUBROUTINES ARE CALLED BY UCROSS.                              00000310
C                                                                       00000320
C                                                                       00000330
C                                                                       00000340
C     UCROSS NEITHER USES NOR ALTERS VARIABLES IN COMMON. ALL INPUT AND 00000350
C         OUTPUT IS THROUGH THE CALLING SEQUENCE                        00000360
C                                                                       00000370
C                                                                       00000380
C                                                                       00000390
      IMPLICIT REAL*8(A-Z)                                              00000400
      DIMENSION A(3),B(3),C(3)                                          00000410
      C(1) =A(2)*B(3)-A(3)*B(2)                                         00000420
       IF(DABS(C(1)).LT.1.0D-20) C(1)=0.D0                              00000430
      C(2) = A(3)*B(1)-A(1)*B(3)                                        00000440
       IF(DABS(C(2)).LT.1.0D-20) C(2)=0.D0                              00000450
      C(3) = A(1)*B(2)-A(2)*B(1)                                        00000460
       IF(DABS(C(3)).LT.1.0D-20) C(3)=0.D0                              00000470
      CMAG=DSQRT(C(1)*C(1) + C(2)*C(2) + C(3)*C(3))                     00000480
C  CHECK TO SEE IF CMAG=0 TO PREVENT DIVIDING BY ZERO IN THE NEXT       00000490
C  THREE CALCULATIONS                                                   00000500
      IF (CMAG.EQ.0.D0) GO TO 5                                         00000510
      C(1)=C(1)/CMAG                                                    00000520
      C(2)=C(2)/CMAG                                                    00000530
      C(3)=C(3)/CMAG                                                    00000540
    5 CONTINUE                                                          00000550
      RETURN                                                            00000560
      END                                                               00000570
C          DATA SET VELASY     AT LEVEL 003 AS OF 06/22/79              00000000
C          DATA SET VELASY     AT LEVEL 002 AS OF 05/30/79              00000010
C          DATA SET VELASY     AT LEVEL 001 AS OF 04/04/78              00000020
      SUBROUTINE VELASY(ARE1,ARE2,CONBRO,VBARS,ASYS)                    00000030
C                                                                       00000040
C                                                                       00000050
C  SUBROUTINE VELASY(ARE1,ARE2,CONBRO,VBARS,ASYS)                       00000060
C                                                                       00000070
C  THE PURPOSE OF VELASY IS TO COMPUTE THE VELOCITY VECTORS AT EACH     00000080
C  BODY FOR A GIVEN TRANSFER CONIC                                      00000090
C                                                                       00000100
C  ARGUMENTS IN THE CALLING SEQUENCE ARE DEFINED AS FOLLOWS:            00000110
C                                                                       00000120
C  ARGUMENT  TYPE  I/O    DEFINITION                                    00000130
C                                                                       00000140
C    ARE1    R*8    I     POSITION AND VELOCITY OF BODY 1               00000150
C                         WITH RESPECT TO THE CENTRAL BODY              00000160
C    ARE2    R*8    I     POSITION AND VELOCITY OF BODY 2 WITH RESPECT  00000170
C                         TO THE CENTRAL BODY                           00000180
C    CONBRO  R*8    I     ORBIT AND MANEUVER QUANTITIES:                00000190
C                           CONBRO(1)-FLIGHT PATH ANGLE AT BODY 1       00000200
C                           CONBRO(2)-VELOCITY AT BODY 1,WRT CENTRAL    00000210
C                              BODY                                     00000220
C                           CONBRO(5)-CENTRAL BODY BETWEEN BODIES 1 & 2 00000230
C                           CONBRO(7)-FLIGHT PATH ANGLE AT BODY 2       00000240
C                           CONBRO(8)-VELOCITY AT BODY 2, WRT CENTRAL   00000250
C                              BODY                                     00000260
C    VBARS   R*8    O     VELOCITY VECTORS WITH RESPECT TO THE CENTRAL  00000270
C                         BODY                                          00000280
C    ASYS    R*8    O     VELOCITY VECTOR WITH RESPECT TO               00000290
C                         BODY 1 (VS(1-3)) AND BODY 2 (VS(4-6))         00000300
C                                                                       00000310
C  VELASY IS CALLED BY THE FOLLOWING SUBROUTINE:                        00000320
C                                                                       00000330
C      RANTAR                                                           00000340
C                                                                       00000350
C  VELASY CALLS THE FOLLOWING SUBPROGRAMS:                              00000360
C                                                                       00000370
C       DOT   VNORM                                                     00000380
C                                                                       00000390
C  THE VARIABLE APPEARING IN A COMMON BLOCK IS GIVEN BELOW:             00000400
C                                                                       00000410
C  COMMON VARIABLE USED: XPI                                            00000420
C                                                                       00000430
C                                                                       00000440
      IMPLICIT REAL*8(A-H,O-Z,$)                                        00000450
      COMMON /CONST/ S2LB,D2R,XPI,R2D,F2KM,XKM2F,G0                     00000460
      DIMENSION     VBARS(6),      ASYS(6),       CONBRO(8),     X(8)   00000470
C  SUBROUTINE VELASY IS SUBRS VELVEC AND ASYVEC COMBINED                00000480
     1,             XHAT1(3),      XHAT2(3),      ARE1(6),       ARE2(6)00000490
     *                                                                  00000500
      DIMENSION     VBAR1(3),      VBAR2(3)                             00000510
      EQUIVALENCE  (X(1),FPA1),      (X(2),VE1),       (X(5),PSI)       00000520
      EQUIVALENCE  (X(7),FPA2),      (X(8),VE2)                         00000530
C                                                                       00000540
      DO 9 I=1,8                                                        00000550
      X(I)=CONBRO(I)                                                    00000560
9     CONTINUE                                                          00000570
C  COMPUTE THE UNIT VECTOR IN THE DIRECTION FO R1                       00000580
      CALL VNORM(ARE1,XHAT1)                                            00000590
      C1=DOT(XHAT1,ARE2)                                                00000600
C  THIS DO LOOP COMPUTES A UNIT VECTOR WHICH LIES IN THE PLANE OF THE   00000610
C  TWO VECTORS, R1 AND R2, AND IS SIMULTANEOUSLY NORMAL TO R1.          00000620
      DO 1 I=1,3                                                        00000630
    1 XHAT2(I)=ARE2(I)-C1*XHAT1(I)                                      00000640
      CALL VNORM(XHAT2,XHAT2)                                           00000650
      CPSI=DCOS(PSI)                                                    00000660
      SPSI=DSIN(PSI)                                                    00000670
C  THE NEXT 4 STATEMENTS COMPUTE SIN (FPA2-PSI) AND COS (FPA2-PSI)      00000680
      C1=VE2*DCOS(FPA2)                                                 00000690
      C2=VE2*DSIN(FPA2)                                                 00000700
      C3=CPSI*C2-SPSI*C1                                                00000710
      C4=SPSI*C2+CPSI*C1                                                00000720
      C1=VE1*DSIN(FPA1)                                                 00000730
      C2=VE1*DCOS(FPA1)                                                 00000740
      IF(PSI.LE.XPI) GO TO 2                                            00000750
      C2=-C2                                                            00000760
      C4=-C4                                                            00000770
    2 CONTINUE                                                          00000780
      DO 20 I=1,3                                                       00000790
      J=I+3                                                             00000800
C  THE NEXT TWO STATEMENTS COMPUTE THE VELOCITY VECTORS AT BODIES       00000810
C  1 AND 2 WITH RESPECT TO THE CENTRAL BODY.                            00000820
      VBAR1(I)=C1*XHAT1(I)+C2*XHAT2(I)                                  00000830
      VBAR2(I)=C3*XHAT1(I)+C4*XHAT2(I)                                  00000840
      ASYS(I)=VBAR1(I) - ARE1(J)                                        00000850
      ASYS(J)=VBAR2(I) - ARE2(J)                                        00000860
      VBARS(I)=VBAR1(I)                                                 00000870
      VBARS(J)=VBAR2(I)                                                 00000880
20    CONTINUE                                                          00000890
      RETURN                                                            00000900
      END                                                               00000910
C          DATA SET VNORM      AT LEVEL 003 AS OF 06/19/79              00000000
C          DATA SET VNORM      AT LEVEL 002 AS OF 05/30/79              00000010
C          DATA SET VNORM      AT LEVEL 001 AS OF 04/04/78              00000020
      REAL FUNCTION VNORM*8(Z,W)                                        00000030
C                                                                       00000040
C  REAL FUNCTION VNORM*8(Z,W)                                           00000050
C                                                                       00000060
C  VNORM COMPUTES THE UNIT VECTOR COMPONENTS (W) OF THE INPUT           00000070
C  VECTOR (Z), AND THE MAGNITUDE OF Z.                                  00000080
C                                                                       00000090
C  ARGUMENTS IN THE CALLING SEQUENCE ARE DEFINED AS FOLLOWS:            00000100
C                                                                       00000110
C  ARGUMENT  TYPE  I/O    DEFINITION                                    00000120
C                                                                       00000130
C     Z      R*8    I     INPUT VECTOR                                  00000140
C     W      R*8    O     OUTPUT UNIT VECTOR                            00000150
C   VNORM    R*8    O     MAGNITUDE OF Z                                00000160
C                                                                       00000170
C  VNORM IS CALLED BY THE FOLLOWING SUBROUTINES:                        00000180
C                                                                       00000190
C     GEOSX   GEOSY   VELASY                                            00000200
C                                                                       00000210
C  NO SUBROUTINES ARE CALLED BY VNORM                                   00000220
C                                                                       00000230
C  VNORM NEITHER USES NOR ALTERS VARIABLES IN COMMON.  ALL INPUT        00000240
C  AND OUTPUT IS THROUGH THE CALLING SEQUENCE.                          00000250
C                                                                       00000260
      IMPLICIT REAL*8(A-H,O-Z,$)                                        00000270
      DIMENSION       Z(3),W(3)                                         00000280
C  SCL=MAGNITUDE OF THE VECTOR, Z                                       00000290
      SCL = DSQRT(Z(1)**2 + Z(2)**2 + Z(3)**2)                          00000300
      IF (SCL .EQ. 0.D0) GO TO 20                                       00000310
C  COMPUTE THE COMPONENTS OF THE UNIT VECTOR, W                         00000320
      DO 2 I=1,3                                                        00000330
    2 W(I) = Z(I)/SCL                                                   00000340
      VNORM = SCL                                                       00000350
      RETURN                                                            00000360
20    VNORM = 0.D0                                                      00000370
      DO 5 I=1,3                                                        00000380
5     W(I)= 0.D0                                                        00000390
      RETURN                                                            00000400
      END                                                               00000410
